perm filename EXEC.MAC[10X,MRC]4 blob
sn#398910 filedate 1978-11-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00378 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00025 00002 TITLE EXEC
C00028 00003 TAB LF FORMF CR EOL ALTM FDBCTL FDBTMP FDBNEX FDBDEL FDBNXF FDBUND FDBEPH FDBPRT FDBBYV FDBSIZ FDBCRV FDBWRT FDBRED FDBUSW DDTORG DDTSYM MAXJFN
C00031 00004 CBT CHR TRM KWV KWV1 BFP .BFP CNT
C00034 00005 ERROR $ERROR .ERROR TYPE $TYPE ETYPE NOISE CONFIRM ALTYPE TRAP INHELP
C00036 00006 BTCHER INTOFF INTON
C00037 00007 ..T PDL CBUFL CSBUFL JBUFL EDFILL NTTYMD SGTBLN
C00039 00008 ALPHAN OCTDIG PUNBIT TEOL TSPC TALT TCOM TLPR TRPR TCOL TLAN TRAN
C00040 00009 COMOK EOLOK LPROK NSPALT WHLUO OPRUO ERRUO WOEPUO LANOK INVIS
C00043 00010 ONEWD NOCONF CONMAN ALTCON NOLOG PROGX EASUB CONFRC
C00046 00011 PUNCF STCF CTRLVF BAKFF DASHF NECHOF RUNF CTLCF1 CTLCF2 LOGOFF DTACHF NEOLF EOLNEF GROUPF F3 F2 F1
C00049 00012 B0 B1 B2 B3 B4 B5 B6 B7 B8 B9 B10 B11 B12 B13 B14 B15 B16 B17 NSBUF BUF1 BUF2
C00051 00013 Z A B C D E F G AA BB CC DD EE FF GG P CALL RET
C00052 00014 .P .JBUFP JBUFP JBUF INIFH1 INIFH2 EOFDSP ILIDSP ERRMF
C00054 00015 CINITF STRTAC AUTFLG APJFN DTSF PRVENF PROPSF MESMSF MSGTIM LOCAL DOT CUSRNO FORK LRFORK IDFORK DBFORK UFORK DDTFLG NPAGE EFORK XFORK STRTIM TTYACF ALOFH PTTYMD ETTYMD SUPSUB CTLIM0 CTLIM1
C00058 00016 PRIMRY CIJFN COJFN CRJFNI CRJFNO CREDIF CREDOF CERET CTUUO CSTRR FRSTFR %EDAYT CSBUFP ERCOD ERPC DWNMSF
C00061 00017 DOWNTM UPTIME WHYHLT FRAME IUSRNM EDFILE DEVICE DIRNO OLDDIR OUTDSG INDSG LPNAME LPEXT LPFDB LFPOS GHEAD HEAD HEDLNO SPCG WIDTH LENGTH L35 L50 PAGENO PAGEN1 BESPTR BESCOR BESLNO PPRINT LEV1PC LEV2PC LEV3PC
C00065 00018 PD CBUF CBUFE CWBUF CJFNBK CSBUF CSBUFE PPATS SGTNAM SGTAC1 SGTAC2 PAGEN
C00068 00019 EXEC ..JBSYM ..JBUSY VERTXT VERSN PATVER PATS CUUOT CUUO
C00071 00020 .VERSI VERSI1 VERSI2 CMD2A3
C00073 00021 AUTOST AUTO0 REE
C00074 00022 EXEC0 EXEC0A EXEC06
C00078 00023 EXEC0B
C00080 00024 EXEC0C
C00082 00025 CMDIN1 CMDIN2 ERRET
C00085 00026 CMDN2B CMDN2C
C00087 00027 CMDN2D
C00089 00028 CMDIN4
C00091 00029 CMDN5B
C00093 00030 CMDN5D
C00095 00031 CMDN5E CMDN6 CMDN6A CMDN6B CMDN6C CMDN6D CMDN6E CMDN6J
C00099 00032 CMDN6K
C00100 00033 CMDN7 CIN0A
C00103 00034 CIN1A CIN1C
C00106 00035 CIN2 CIN2B
C00108 00036 CIN3 CIN3C CIN3B CIN3A
C00110 00037 CIN4 CIN4A CIN40 CIN41 CIN42 CIN43 CIN44 CIN45
C00114 00038 CIN5
C00115 00039 CIN6
C00117 00040 CSLSH
C00119 00041 CBKSL CBKSL1 CBKSL5
C00121 00042 ALOTST ALOFRK ALF1 ALF2 ALF3
C00123 00043 READ ONLY STORAGE AREA
C00125 00044 CTBL1
C00136 00045 CTBL2
C00139 00046 CHRTBL
C00143 00047 LEVTAB CHNTAB
C00145 00048 SPECIFIC EXEC COMMAND ROUTINES
C00147 00049 .STATU .JOBST JOBST0
C00149 00050 FSTR1 FSTR2 FSTRUC
C00152 00051 .RUNST RUNST8 LAPRNT
C00154 00052 FSTAT FSTAT4 FSTAT8 FSTAT9
C00156 00053 .PISTA Job TIW
C00158 00054 .IMPST IMPST0 IMPST1 IMPST2 IMPST3 IMPST4 IMPS45 IMPST5 IMPST6 IMPSTX
C00163 00055 .USEST
C00164 00056 .DSKST .DISCU DSKCNT DSKST1 DSKST2 DSKST3 DSKST5 DSKST4 CHKDAL
C00168 00057 .MEMST MEMS1 MEMS2 MEMS3
C00170 00058 MMAP MMAP1 MMAP2 MMAP6 MMAP7
C00173 00059 MMAP10 MMAP11 MMAP13
C00176 00060 NPAGID PAGID PAGID8 PAGID9
C00179 00061 .FILST ASTTJ
C00181 00062 JSTAT ILIJFN
C00183 00063 JSTAT2 JSTAT3 JSTAT4 JSTAT5 JSTAT6 JSTAT7 JSTAT8 JSTAT9 JSTA10
C00185 00064 .SYSTA SYST1 SYST2 SYST3
C00188 00065 SYST4 SYST5 SYST5A SYST8 SYST8A SYST8Y SYST9 SYST8X SYST8W
C00192 00066 .STATI
C00194 00067 STAT3 STAT51 STAT5A STAT6A STAT6B STAT6C STAT6E STAT6F STAT6G STAT5C STAT5Y STAT5Z STAT6 STAT5N SNAMS
C00198 00068 .ERRST SYST11 SYST12
C00200 00069 READT MORET READT1
C00202 00070 .TRMST TRMST0 TRMST1 TRMST2 TRMST3 TRMST4 TRMST5 TRMST6 TRMS60 TRMS61 TRMS62 TRMS63 TRMS64 TRMST7 TRMST8 TRMST9 TRMS10 TRMS11 TRMS12 TRMS13 TRM131 TRM132 TRMS14 TRM141 TRM142 TRM143 TRM144 TRM145
C00208 00071 .FULLD .HALFD .FORMF .TABS TABS1 .SHOW .LOWER .RAISE CMOD .LLENG
C00212 00072 .TERMI $TERMI TRMTAB .VT06 .VTCR .HYTYP .DMN .DM .TI733 .T33 .T35 .T37 .LA30 .NVT .TTY3 .SCOPE SCOPE1 SCOPE2 .BENDI .BEEHI .INFOT .DATA1 .VTS .TI .TI1
C00218 00073 .LWIDTH
C00219 00074 .INDIC .INDI1 CCCOC CCCOCS
C00221 00075 .ACCES ACCES1 ACCES2 ACCE21 ACCES3 ACCES4 ACCE.T $ACCS1 $ACCS2
C00225 00076 .ACCOU ACCOU0 ACCOU1 ACCOU2 ACCOU3
C00227 00077 .ADVIS
C00228 00078 .ASSIG
C00231 00079 ASSIG3 ASSIG5
C00233 00080 .ATTAC
C00235 00081 ATAC4B
C00237 00082 ATTAC5 ATA5A ATA5B ATA5C
C00239 00083 ATTAC7
C00241 00084 .AVAIL $AVAIL ..TERM TERMI1 TERMI9 EOLRET .PTYS .PTY1 .PTY2 .PTY3 .NVTS TERMY1 TERMY9
C00245 00085 .DEVIC BEFORE
C00247 00086 DEVLUP DEVL1 SIXPRT SIXPR1
C00249 00087 .BREAK BREAK1 BREAK3
C00250 00088 .CHANG $CHANG C.PSWD C.PSW0 C.PSW1 C.PSWT
C00255 00089 .CLEAR
C00256 00090 .CLOSE .COMMA .CONNE CONNE4
C00258 00091 $CONTI .CONTI ..CONT
C00260 00092 .DAYTI .DAYT1 .DAYT3 .DAYT5 .DAYT2 .DAYT4
C00263 00093 .DELET DELET0 DELET2 DELET3 DELET1
C00265 00094 .DDT DDT1 DDT2
C00268 00095 DDT3 DDT4
C00270 00096 .DEASS .DUMP
C00272 00097 .EDIT EDIT1 EDIT2 EDIT3 EDIT4 EDIT5 EDIT6 EDIT7 EDIT8
C00277 00098 .ENTRY ENTRY5
C00278 00099 .NOTEP .EPHEM
C00279 00100 .EXEC EXEC1 .NEXEC
C00280 00101 .EXPUN $EXPUN ..EXAL ..EXDL ..EXPE ..EXSC ..EXTM ..EXPU
C00282 00102 .FORK FORK1 FORK2
C00284 00103 .MERGE $MERGE $GET1 $GET11
C00286 00104 .ERUN ERUN0
C00287 00105 .RUN .GET GET1
C00289 00106 $GET2 GET2B GETILI
C00291 00107 ECFORK
C00293 00108 SUBNAM SUBN4 SUBN4A SUBN5
C00295 00109 .GOTO GOTO2
C00297 00110 .BDDT BDDT1 BDDT5 .NOBD
C00299 00111 .IDDT IDDT1 IDDT5 .NOID
C00301 00112 CDBGFK
C00303 00113 LDRUND LDRUN2 LDRUN3 LDRUN4
C00305 00114 USPLIC RSPLIC RSPLI5
C00307 00115 .INTER .FINGE .SINK
C00309 00116 .JFNCL
C00310 00117 .LIMIT $LIMIT .CORE .CPU .DISK .KILOC
C00312 00118 .LINK
C00313 00119 .LOGIN LOGIN0 LOGIN1
C00317 00120 LOGIN6 LOGI61 LOGIN7 LOGIN8
C00320 00121 SPECEOL USERN USERN2 LGNCHK TYPE <
C00323 00122 ACCT ACCT0 ACCT1 ACCT2 ACCTX PIE.P PIEPX
C00326 00123 DEFACT DEFA15 DEFAC2 DEFAC3
C00328 00124 PASWD
C00330 00125 PASWD1 PASWD3
C00333 00126 PSWDCK PSWDC4 PSWDCX
C00335 00127 MESMES MESMS9
C00337 00128 DWNTIM DWNTI5 DWNTI9
C00339 00129 TRYGTJ TRYG9
C00341 00130 MESS MESS2 MESS3 MESS4 MESS7 MESS8 MESS9
C00344 00131 .KKJOB .LOGOU LOGOU1 LOGO14 LOGOU2 LOGOU3
C00347 00132 JOBCNT JOBCN1 JOBCN2 JOBCN8 JOBC84 JOBCN9 JOBCNX
C00349 00133 .MAIL $MAIL M..CHK M..WAT $M.WAT M.WA.F M.WA.N
C00351 00134 CHKMSG CHKMS4 CHKMS9
C00353 00135 .MOUNT
C00354 00136 .NO $NO
C00355 00137 .NOT $NOT
C00356 00138 .NUMBE
C00357 00139 .NOTPE .PERPE PERPE0
C00359 00140 .PRNTR $PRNTR P..CHK P..WAT $P.WAT P.WA.F P.WA.N DEFDIR DEFDI1
C00361 00141 CHKPRN CHKPR1 CHKPRX
C00362 00142 .QUIT QUIT1 QUIT2
C00364 00143 INFER INFER0 INFER1 INFER3 INFRS INFER6 INFER9
C00366 00144 .PROTE
C00368 00145 .RECEI $RECTB ..ADVZ ..LINK
C00370 00146 $REENT .REENT ..REEN
C00372 00147 .REFUS
C00373 00148 .RENAM
C00375 00149 .RESET RESET RESET2 RESE25 RESET3 RESE30 RESE31 RESE32 RESET4
C00378 00150 .SAVE SAVE1
C00381 00151 SAVNOI SAVNO1
C00383 00152 .SHUT
C00384 00153 .SSAVE SSAV1
C00386 00154 .STOPS STOPS1
C00388 00155 $START .START ..STRT START1 START2
C00391 00156 WAIT WAIT2
C00394 00157 INVOLT WHY IFORK CHKPAT
C00400 00158 .UNDEL UNDEL1 UNDEL8
C00402 00159 .UNMOU
C00403 00160 .UNLOA .REWIN
C00405 00161 .WHERE WHERE1 WHERE2 WHERE4 WHERE5 WHER51 WHER52 WHER58 WHERE6 WHERE7 WHERE8 WHERE9 LITC3
C00411 00162 PDP-10 TENEX EXECUTIVE ** X2CMD.MAC **
C00414 00163 .TTYPE .PRINT TTPRNT .APPEN .COPY COP1A COPFL
C00418 00164 COP2A
C00420 00165 COP3
C00423 00166 COPDF1 COPDEF
C00424 00167 COPDF3 COPDF4 COPDF5 COPDF6 COP4
C00427 00168 COP5A COP5B
C00431 00169 COP6C COP6Z
C00433 00170 COP7A
C00436 00171 COPTTY COPTT1 CTTEOF
C00438 00172 COPBY COPB1 CBYEOF CBYEF1 CBYEF2
C00441 00173 CPGBYT CPGBY2 CPGBY3 CPGBY4 CPBEOF
C00444 00174 CBYTPG CBYPG2 CBPGEF CBPEF3
C00446 00175 PAGES PAGES3 PAGES4
C00448 00176 PAGES5 PAGE5A PAGES6
C00450 00177 PAGES9 COPEOF
C00452 00178 $FNUFP $FFUFP
C00453 00179 $COPY .ASCII ASCII1 $ASCII .BINAR .BYTE .IMAGE $IMAGE .RECOR
C00455 00180 $OPEN7 $OPENF $OPNER
C00458 00181 LIST/TYPE <FILE GROUP DESCRIPTOR>
C00460 00182 LIST/TYPE... STORAGE
C00463 00183 .TYPE .LIST LIST1 LIST01
C00464 00184 LIST1D
C00466 00185 $LIST ..DETA ..DOUB
C00467 00186 .HEADI HEADI1
C00469 00187 ..INDI ..LENG ...LOG ...NO ..OUTP
C00470 00188 .PAGES PAGE1 PAGE2
C00472 00189 .PAUSE .SPACI SPAC2 ..SITE ...VRB .WIDTH
C00474 00190 LSTFL
C00475 00191 LSTH1B
C00477 00192 LSTH2 LSTH2A LSTH2D
C00480 00193 LSTH4 LSTH8 LSTIGE LSTGCK LSTGCE
C00484 00194 LSKIP
C00486 00195 LSTTOP LSP2A LSTP2B LSTP2C
C00488 00196 LSTCL LSTCL1 LSTCL2
C00491 00197 LSTC3A LSTC3B LSTC3C
C00494 00198 LSTC3D LSTC3X
C00495 00199 LSPNFF LSPFF LSPFF1 LSTP1 LSTP15
C00497 00200 LSTP19 LSTP2
C00499 00201 LIST8 LIST9 LIST91
C00501 00202 GGETC GETC
C00504 00203 GETC4 GETC4A GETC7 GETC8
C00506 00204 GETC10 GETC11
C00508 00205 GETC20 LSTEOF LSTE1
C00511 00206 COMCHR COMCH1 COMCH2 COMCHX STRCOM STRCO1 STRCO2 EXTTAB
C00514 00207 SITEO SITEX LITC4A
C00515 00208 .DETAC .REDIR RED2
C00518 00209 RED3 RED4
C00520 00210 REDIRECT/DETACH...
C00521 00211 REDI0 REDI1 REDI2 REDI3 REDI4
C00523 00212 REDO0 REDO1 REDO2 REDO3 REDO4
C00525 00213 $REDIR ..DTCH
C00527 00214 PDP-10 TENEX EXECUTIVE ** X3CMD.MAC **
C00530 00215 .ARCHI $ARCHI ARC.FL ARCH3 ARCH1 ARCH2
C00534 00216 ARC.DL ARC.UN ARC.EX ARC.RS ARC.ST
C00536 00217 ARCSTR $ARC ..ARDF ..ARDL
C00538 00218 ..ARDN $DONT ...DAR ...DDL STATER
C00540 00219 .QFD .QD .QW .QR
C00542 00220 .DIREC DIR0
C00545 00221 DIRFL DDIR
C00548 00222 UNMDIR
C00549 00223 $DIR
C00551 00224 .ALPHA .AUTHO .CHRON $CHRON
C00552 00225 .CRAM .DATES DATES1 .TIMES $DATE ..DELE .DOUBL .EVERY .LENGT
C00554 00226 .LPT $LPT $GTJFN LPT5 .OUTPU ..NO ..PROT .REVER .SEPAR ..SIZE ..TEN5 .VERBO
C00556 00227 DHEAD DHEADX DHEADZ
C00559 00228 DINDNT DHSOUT
C00561 00229 DNAME DNAME4 DNAME5 DNAME6 DNAME8 DNAMEX
C00564 00230 $GTFDB FDBILI
C00566 00231 DSKDIR
C00568 00232 DSKD2
C00570 00233 DSKR1
C00572 00234 DSKR2
C00574 00235 DSKR4 DTADRN DTADRE DTADR1 DTADR9
C00577 00236 DSKR5 DSKR7 DSKR8 DSKR9
C00579 00237 DSKS1 GRATR LESS HERE
C00583 00238 FDBSC
C00585 00239 FDBSC2 FDBSC3 FDBGR FDBEQ FDBLS
C00587 00240 FDBST1 FDBSTC
C00588 00241 DSKP DSKP1 DSKP4 DSKP5
C00590 00242 DFILE
C00592 00243 DFILE DFL02B
C00595 00244 DFL03A DFL03B DFL05 DFL05A
C00597 00245 DFREST DFR06A
C00599 00246 DFR07 DFR08 DFR85
C00601 00247 DFR09 DFR09A DFR09C DFR09D
C00604 00248 DFR10 DFR11 DFR12 DFR129 DFR13 DFRXIT
C00607 00249 DTADAT
C00608 00250 DCMPR DCMPR1 DCMPR9
C00609 00251 DFDBCM DFDC10
C00612 00252 DFNOUT DFILL DFILL9
C00614 00253 OLDTAD OLDTA2
C00616 00254 OLDTA4
C00618 00255 OLDTA7 OLDTA9 LITC5
C00619 00256 ..PRIN
C00622 00257 DIRPNT PR1 PR2
C00624 00258 DIRPNT...
C00626 00259 DIRP11 F3NOT
C00628 00260 $PRINT ..VERB
C00629 00261 SUPER SUPER1 SUPPW
C00630 00262 .CREAT
C00632 00263 CRET1A
C00634 00264 CREAT3 CREAT8 CREAT9 CRET9A
C00636 00265 CRSUB
C00637 00266 $CREAT ....NO $$$$NO .MAILB
C00639 00267 ..NOT .NAME .PASSW
C00641 00268 ..DISK .NETWI .MAINT .WHEEL .OPERA .CONFI CPRIV .FILES .REPEA CCMODE
C00643 00269 .PRIVI .MODE .SPECI CSPEC ...NUM NUMBE1
C00645 00270 ...PRO .DEFAU $DEFAU ....PR ..NUMB
C00647 00271 .RETEN .USER ..DIRE BITIN
C00649 00272 .KILL .ABORT ..LIST $.LIST
C00651 00273 .CYCLE ...DSK $$$DSK
C00653 00274 .EDDT EDDT3 EDDT4 EDDT5
C00655 00275 .DISAB DISAB1 .ENABL ..LOGO
C00657 00276 .HALT HALT0 HALT2 HALT3 HALT4 HALT7 $HALT ..HLTA ..HLTD $HLTDU ..HLTF ..HLTI ..HLTR ..HLTU
C00663 00277 TIMPMN TIMPSC
C00664 00278 .INITI $INITI
C00665 00279 .KFACT .LOAD .NETWO $NETWO
C00666 00280 .OFFLI .ONLIN .ONLI1
C00668 00281 ..PAUS .PERMI .PROCE .PROHI
C00669 00282 .SYSTE $SYSTE
C00670 00283 .SET INDT CHKDAT CHKDA4 CHKDA8 CHKDA9
C00673 00284 .TRAPS $TRAPS ..UNLO
C00674 00285 .NETLO NETLO0 NETLO2
C00677 00286 NETLO4 NETL41 NETL42 NETL43 NETL44 NETLO5 NETL55 NETL56 NETL57 NETLO6 NETL69 NETLO9 NETLOX
C00681 00287 READY READY4 READY2 READY3
C00683 00288 %KEYW
C00687 00289 %KEYW CWRD2 CWRD3 CWRD3A
C00690 00290 CWRD4 CWRD5 CWRD6
C00693 00291 CWRD8
C00695 00292 PRVCK PRVCK8
C00697 00293 FSYM - SYMBOL TABLE LOOKUP SUBROUTINE USED IN %KEYW (PRECEDING)
C00699 00294 FSYM
C00700 00295 FSRC1 FSRC1A FSRC2 UPAR APAR NOMAT FSRC3 FSRC4
C00703 00296 NEM1 NEM2
C00705 00297 SBST SBST1
C00708 00298 %NOI
C00711 00299 NOIA NOI0 NOI0A
C00713 00300 NOI1 IGNOI2 IGNOI1 IGNOI3
C00716 00301 %SBCOM SBCOM1 SBCOM9
C00719 00302 %INHEL UINHE9
C00721 00303 CSTR AND MORE
C00724 00304 CSTR CSTR0 CSTR1 CSTR2 CSTR3 CSTR5
C00727 00305 CSTR9
C00729 00306 PASCOM PASCM1 %ALLOW
C00731 00307 CONF CONF2
C00735 00308 CONF6 CONF7 CONF8 CONF9 CONFE CONFE1
C00738 00309 TCONF TCONF1 TCONFC TCONFX TCONFR
C00741 00310 SPRTR
C00744 00311 CCHRI CCHR1 CCHR8
C00747 00312 $CTRLH $CTRLA CTRLA1 CTRLA2 CTRLA3 $CTRLW CTRLW1 CTRLW2 $CTRLR $CTRLX $RUB
C00751 00313 $FORMF FORMF1 $EOL $DASH $CTRLV $CONT
C00753 00314 UBP CCHEOF CCHEF1 CCHEF2 CCHEF3 CCHEF4
C00755 00315 %TYPE TYP1 TYP2 CTYPE %$TYPE $CTYPE %ALTYP
C00757 00316 COLLECT FILE NAMES:
C00761 00317 COLLECT FILE NAMES COMMENTS...
C00763 00318 COUTFN CINFN CEDFN
C00765 00319 .INFG .INFG1 INFG $INFG DIRARG
C00768 00320 SPECFN CFN1 CFN1A CFN1B
C00771 00321 CFN2
C00773 00322 CFN3 CFN3A CFN3B
C00777 00323 CFN4 CFN4X CFN4Y CFN4Z
C00781 00324 CFN7A CFN7B
C00783 00325 CFN7C CFN7D CFN7Z
C00785 00326 CFN8 CFN9 CFN9A
C00786 00327 CFNE
C00789 00328 INTRM
C00790 00329 LFJFNS LFJF9
C00792 00330 CPFN
C00793 00331 TYPIF GNFIL GNFIL3 GNFIL5 GNFIL8
C00795 00332 FRSTF FRSTF1 NEXTF
C00797 00333 DEVN DEVN1 DEVNE
C00800 00334 DIRNAM DIRNAX
C00802 00335 TTYNUM TTYN1 TTYN2 TTYN3 TTYN4 TTYN5 TTYN6 TTYN7 TTYN8 TTYN9 TTYN10 TTYN11
C00806 00336 DATEIN
C00809 00337 DECIN BIGOCT BIGOC1 INCON1 OCTAL2 OCTAL3 OCTAL7 OCTAL
C00812 00338 OCTCOM OCCOM3 OCCOM5 OCCOM8
C00814 00339 TOCT
C00815 00340 BUFFS BUFFF BUFF0 BUFFF1 BUFFF2 BUFFF3
C00817 00341 ALLBK NALNBK BRKST1 NOECHO DOECHO ECHOST
C00819 00342 NOECEO NOECE1 DOECEO
C00820 00343 LTTYMD LTTYM8 LTTYM9
C00822 00344 RTTYMD RTTYM9
C00823 00345 INETTY INPTTY
C00825 00346 %PRINT PRIN1 CCHRO COUTC
C00827 00347 MAPPF MPPF1 MPPF8 MAPACS LOADF STOREF
C00830 00348 %GTB
C00831 00349 HUPSI HUPSI9 HUPSI8 HUPSI7
C00834 00350 USEPSI USEPS4 USEPS5 USEPS6 DING
C00837 00351 CERR NIM NIYE SCREWUP JERR JERR1 JERRC
C00839 00352 %TRAP
C00842 00353 ILIPSI EOFPSI
C00845 00354 DATPSI
C00846 00355 CCPSI
C00848 00356 CCDB2 CCDB3 CCDB4 CCERET
C00850 00357 ALOPSI ALOPS1 AUTOLO AUTOL6
C00852 00358 %ERR %.$ERR SYSERA SYSERM ERR1 ERR5 ERR04 ERR5A ERR6
C00856 00359 ERR7 ERR7F ERR8 RERET
C00858 00360 ERFRST ERFRS1 ERFRS2 ERFRS3
C00861 00361 CRIF $GETER
C00862 00362 RLJFNS RJFNS1 RJFNS8
C00864 00363 %ETYPE ETYP2 ETYP2A
C00866 00364 ETYP4 ETYP5 END%
C00868 00365 %LETS UN%
C00870 00366 %A A1 A2 %B %B1 %C %D %E
C00872 00367 %F %H
C00874 00368 %I %I1 %I3 %K
C00876 00369 %L %M %G %N
C00878 00370 %O %P %J %Q %Q2 %Q1 FLOAT
C00881 00371 %R %S %T
C00882 00372 %U %U1 %U2 %U3 %V
C00884 00373 %X %X1 %X3 %X9
C00887 00374 %Y %Z %Z1 %Z2
C00888 00375 TOUT
C00889 00376 UNMAP
C00890 00377 $SYSGT SYSGT1 SYSGT2 SYSGT3 SYSGT4
C00892 00378 FPIN
C00894 ENDMK
C⊗;
TITLE EXEC
SUBTTL PDP-10 TENEX EXECUTIVE SYMBOL DEFINITIONS
SEARCH STENEX
.DIREC .XTABM
;***** DEFAULT CONDITIONALS ********
IFNDEF DST10X,<DST10X==0> ;TURNOFF DISTRIBUTED CODE UNLESS
;REQUESTED BY A PARAMETER FILE
;**** THINGS THAT AFFECT THE LANGUAGE EFFECTED BY THIS CODE *****
CTRLC==3 ;SUPER-PANIC PSI CHARACTER
;AND "TERMINAL CODE" FOR SAME
CTCODE==↑D20 ;"TERMINAL CODE" FOR CHARACTER ASSIGNED TO PSI THAT
;PRINT RUNTIME (↑T)
HUCODE==↑D30 ;"TERMINAL CODE" FOR DATAPHONE CARRIER OFF (HANGUP)
BELL==7 ;CHARACTER TO RING WHEN ILLEGAL ↑A OR ↑W INPUT,
;OR WHEN RECOGNITION AMBIGUITY REQUIRES MORE INPUT
CTRLE==5 ;CHARACTER THAT PREFIXES PRIVILEGED COMMANDS
CTRLZ==32 ;EOF CHARACTER FOR "COPY" COMMAND WHEN TTY IS SOURCE
CONTCH==176 ;STORED INTERNALLY FOR CONTINUATION CHARACTER (&).
;ONE BYTE, TRANSLATED BACK TO EOL-SPACE-& ON OUTPUT
;FOR ↑R, ↑A. THIS CHAR MUST NEVER TURN UP OTHERWISE;
;IS 176 THE BEST VALUE?
;ALSO MANY CHARACTERS ARE GIVEN SPECIAL FUNCTIONS BY THEIR ENTRIES
; IN THE CHARACTER TABLE (CHRTBL) IN RS.MAC.
;AUTOMATIC LOGOUT PARAMETERS:
;AUTOLOGOUT OCCURS IN TOP-LEVEL EXEC WHEN JOB IS NOT LOGGED IN AND:
; 1) EXEC RETURNS TO COMMAND INPUT AND AT LEAST AUTOLO1 SECONDS
; HAVE ELAPSED SINCE EXEC WAS STARTED, OR
; 2) AUTOL2 SECONDS HAVE ELAPSED SINCE STARTUP AND THERE HAS
; BEEN NO TELETYPE ACTIVITY FOR AUTOL3 SECONDS.
AUTOL1==↑D120
AUTOL2==↑D60
AUTOL3==↑D30
;CONTROL T PARAMTERS
CTTIM0==↑D15 ;MAX. ↑T INTERVAL THAT CAUSES FULL TYPEOUT
CTTIM1==1 ;MIN. INTERVAL BETWEEN TYPEOUTS (CAN BE 0)
;TAB LF FORMF CR EOL ALTM FDBCTL FDBTMP FDBNEX FDBDEL FDBNXF FDBUND FDBEPH FDBPRT FDBBYV FDBSIZ FDBCRV FDBWRT FDBRED FDBUSW DDTORG DDTSYM MAXJFN
;****************** SYSTEM DEPENDENT THINGS ********************
; ASCII CHARACTERS - IF ANY ARE CHANGED, MUST ALSO CHANGE "CHRTBL"!
TAB==11 ;TAB (↑I ON MODEL 33 TTY)
LF==12 ;LINE FEED
FORMF==14 ;FORM FEED
CR==15 ;CARRIAGE RETURN
EOL==37 ;CHARACTER FOR END OF LINE (CR-LF)
ALTM==33 ;ALT MODE, ESC, ETC KEY
; FILE DESCRIPTOR BLOCK IN FILE DIRECTORY
FDBCTL==1 ;CONTROL BITS WORD
FDBTMP==1B0 ;TEMPORARY FILE CONTROL BIT
FDBNEX==B2 ;FILE DOESN'T EXIST (NO EXTS) CONTROL BIT
FDBDEL==1B3 ;FILE DELETED BIT IN CONTROL BITS WORD
FDBNXF==B4 ;FILE DOESN'T EXIST (WRITE INCOMPLETE) CONTROL BIT
FDBUND==1B9 ;FILE IS NOT DELETABLE (PERPETUAL, IMMORTAL,...!)
FDBEPH==1B17 ;FILE IS AN EPHEMERON
FDBPRT==4 ;PROTECTION WORD
FDBBYV==11 ;# VERSIONS TO RETAIN, BYTE SIZE, # PAGES
FDBSIZ==12 ;BYTE COUNT THAT WOULD ADDRESS EOF
FDBCRV==13 ;VERSION CREATE DATE & TIME
FDBWRT==14 ;DATE AND TIME OF LAST WRITE
FDBRED==15 ;READ DATE & TIME
FDBUSW==24 ;USER SETTABLE WORD
;WHERE DDT (UDDT.SAV) RESIDES
DDTORG==770000
DDTSYM==DDTORG+1 ;LOCATION IN DDT THAT POINTS TO LOC WHERE
;SYMBOL TABLE POINTER IS STORED ($I-1)
MAXJFN==155 ;FOR FILSTAT, RLJFNS, ETC
;CBT CHR TRM KWV KWV1 BFP .BFP CNT
;*********** DEFINITIONS THAT ARE INTERNAL TO EXEC ***********
;MNEMONIC AC'S
CBT=7 ;DESCRIPTIVE BITS FROM "CHRTBL" FOR LAST CHARACTER
CHR=10 ;INPUT CHARACTER
TRM=11 ;LAST INPUT FIELD TERMINATOR
KWV=12 ;VALUE WORD RETURNED BY LAST KEYWORD TABLE LOOKUP
KWV1=13 ;KWV SAVED AFTER FIRST KEYWORD IN COMMAND
BFP=14 ;COMMAND BUFFER POINTER
.BFP=15 ;DITTO SAVED AT BEGINNING OF LAST FIELD
CNT=16 ;NUMBER OF CHARACTERS IN FIELD (REQUIRED BY
;EDITING STUFF)
;UUO'S USED IN EXEC. MOST HAVE CALLING MACROS.
;NOTE: UUO DISPATCH TABLE AND DISPATCHER ARE AT BEGINNING OF XMAIN.MAC.
; UUO ROUTINES ARE IN XSUBRS.MAC.
OPDEF UERR[1B8] ;ERROR MESSAGE
OPDEF UTYPE[2B8] ;TYPE MESSAGE
OPDEF KEYWD[3B8] ;KEYWORD INPUT AND LOOKUP
OPDEF UNOI[4B8] ;NOISE WORD INPUT/OUTPUT
OPDEF U$TYPE[5B8] ;TYPE AND STORE MESSAGE
OPDEF ALLOW[6B8] ;CHECK LAST CHARACTER'S DESCRIPTIVE BITS
OPDEF UALTYP[7B8] ;TYPE AND STORE MESSAGE IF
; AC "TRM" CONTAINS ALT MODE
OPDEF U$ERR[10B8] ;ERROR MESSAGE WITHOUT CR FIRST
OPDEF UETYPE[11B8] ;TYPE MESSAGE AND INTERPRET % CODES
OPDEF GTB[12B8] ;CONVENIENT INTERFACE TO THE GETAB JSYS
OPDEF PRINT[13B8] ;PRINT ASCII CHARACTER FROM EFF ADDR
OPDEF UTRAP[14B8] ;ERROR PSI MESSAGE
OPDEF U.$ERR[15B8] ;ERROR THAT DOESN'T CLEAR BUFFERS (↑X)
OPDEF UINHEL[16B8] ;INPUT A FIELD AND GIVE HELP ON "?"
OPDEF SUBCOM[17B8] ;INPUT AND DISPATCH ON SUBCOMMANDS
;ERROR $ERROR .ERROR TYPE $TYPE ETYPE NOISE CONFIRM ALTYPE TRAP INHELP
;MACROS TO CALL UUO'S AND SUBROUTINES
DEFINE ERROR (TEXT)
< UERR [ASCIZ @TEXT@]
>
DEFINE $ERROR (TEXT)
< U$ERR [ASCIZ @TEXT@]
>
DEFINE .$ERROR (TEXT)
< U.$ERR [ASCIZ @TEXT@]
>
DEFINE TYPE (TEXT)
< UTYPE [ASCIZ @TEXT@]
>
DEFINE $TYPE (TEXT)
< U$TYPE [ASCIZ @TEXT@]
>
DEFINE ETYPE (TEXT)
< UETYPE [ASCIZ @TEXT@]
>
DEFINE NOISE (TEXT)
< UNOI [ASCIZ @TEXT@]
>
DEFINE CONFIRM
< CALL CONF
>
DEFINE ALTYPE (TEXT)
< UALTYP [ASCIZ @TEXT@]
>
DEFINE TRAP (TEXT)
< UTRAP [ASCIZ @TEXT@]
>
DEFINE INHELP (TEXT)
< UINHEL [ASCIZ @TEXT@]
>
;BTCHER INTOFF INTON
; THE FOLLOWING SIMULATE UNIMPLEMENTED JSYS'S
;HYPOTHETICAL FUTURE JSYS TO STOP NON-INTERACTIVE JOB
DEFINE BTCHER
<>
;TURN OFF INTERRUPTS
DEFINE INTOFF <
MOVEI 1,400000
DIR>
;TURN ON INTERRUPTS
DEFINE INTON<
MOVEI 1,400000
EIR>
;..T PDL CBUFL CSBUFL JBUFL EDFILL NTTYMD SGTBLN
;COMMAND TABLE MACROS
;AN ENTRY
;ALSO USED FOR DEFAULT INFORMATION AFTER "KEYWD" MACRO
DEFINE T(TEXT,BITS,ADDR)
< IFB <ADDR>,<..A=.'TEXT>
IFNB <ADDR>,<..A=ADDR>
[BITS+0,,..A],,[ASCIZ @TEXT@]
>
;HANDIER MACRO FOR USE WHERE "EOLOK" BIT IS TO BE SET
DEFINE TE (TEXT,BITS,ADDR)
< T <TEXT>,EOLOK!BITS,ADDR>
;A "FAKE" ENTRY TO FORCE AN AMBIGUITY
DEFINE X (TEXT)
< T <TEXT'!>,NOLOG+EOLOK+INVIS,CERR
>
;BEGIN TABLE.
;FIRST WORD MUST BE NUMBER OF ENTRIES
DEFINE TABLE
< Z ;FILLED IN BY NEXT TEND
..T==. ;USED BY NEXT TEND
>
;END TABLE
DEFINE TEND
< ..U==.
LOC ..T-1
..U-..T ;FILL IN FIRST WORD OF TABLE
LOC ..U
>
;AREA SIZES
PDL==120 ;PUSHDOWN
CBUFL==↑D50 ;COMMAND BUFFER LENGTH. DETERMINES LENGTH OF COMMAND.
CSBUFL==↑D40 ;STRING BUFFER MINIMUM SIZE (ACTUAL DEPENDS ON
;PAGE BOUNDARY).
;BIG ENOUGH FOR USR NAME, PASSWD, ACCT #, AND THEN SOME
JBUFL==17 ;JFN BUFFER LENGTH: ONE MORE THAN # JFNS IN A CMD.
EDFILL==17 ;FILE NAME.EXT SAVED BY EDIT COMMAND
;(FIRST WORD IS POINTERS)
NTTYMD==11 ;NUMBER OF TTY, ETC. MODE WORDS
SGTBLN==↑D40 ;SIZE OF THE $SYSGT HASH TABLE(S)
;ALPHAN OCTDIG PUNBIT TEOL TSPC TALT TCOM TLPR TRPR TCOL TLAN TRAN
;BITS BITS BITS
;CHARACTER DESCRIPTION BITS.
;USED IN ENTRIES IN CHARACTER TABLE (CHRTBL) AND THUS THEY APPEAR
; IN AC "CBT" AND IN CALLS TO "ALLOW" UUO.
;BIT SET FOR ---
ALPHAN==1 ;ALHPANUMERIC CHARACTERS AND "-"
OCTDIG==2 ;OCTAL DIGITS 0 THRU 7
PUNBIT==4 ;PUNCTUATION = MOST OTHER PRINTING CHARACTERS
TEOL==10 ;EOL AND SEMICOLON
TSPC==20 ;SPACE AND TAB
TALT==40 ;ALT MODE
TCOM==100 ;COMMA
TLPR==200 ;LEFT PAREN
TRPR==400 ;RIGHT PAREN
TCOL==1000 ;COLON (FOR DEVICE NAMES)
TLAN==2000 ;LEFT ANGLE BRACKET
TRAN==4000 ;RIGHT ANGLE BRACKET (>)
;COMOK EOLOK LPROK NSPALT WHLUO OPRUO ERRUO WOEPUO LANOK INVIS
;BITS IN LEFT HALF OF VALUE WORD IN KEYWORD TABLES
;BITS DEFINED HERE ARE RETURNED IN LEFT HALF OF AC "KWV" BY THE LOOKUP
; UUO, "KEYWD".
;SOME OF THESE BITS ARE INTERPRETED BY %KEYW ITSELF, AND SOME ARE
; USED BY ITS CALLERS, AS FOLLOWS.
;THIS FIRST GROUP IS TESTED IN %KEYW, THE SERVICE ROUTINE FOR "KEYWD".
;BIT -- ;MEANING IF BIT ON --
COMOK==1 ;COMMA IS OK AS TERMINATOR FOR THIS WORD
EOLOK==2 ;CARRIAGE RETURN OR SEMICOLON OK AS TERM FOR THIS WORD
; ALSO, "EOLOK" IS IMPLIED BY "ONEWD"
LPROK==4 ;LEFT PAREN OK TO TERMINATE THIS WORD
;(USED WHERE A NOISE WORD CAN FOLLOW)
NSPALT==10 ;DON'T TYPE SPACE AFTER A WORD TERMINATED WITH ALT MODE
;WHLUO, OPRUO, ERRUO REFER TO SPECIAL CAPABILITIES ENABLED:
WHLUO==20 ;DON'T RECOGNIZE KEYWORD IF USER DOESN'T HAVE WHEEL PRIV
OPRUO==40 ; " " " " " " " OPERATOR PRIVILEGE
ERRUO==100 ; " " " " " " " CONFIDENTIAL INFORMATION ACCESS PRIV
WOEPUO==200 ;DON'T RECOGNIZE KEYWORD IF USER HAS NEITHER WHEEL NOR
;OPER NOR CONF INF ACCESS SPECIAL CAP POSSIBLE
;(NEEDN'T BE ENABLED)
;NOTE: IF MORE THAN ONE OF THE PRIVILEGE BITS ARE ON,
;THE KEYWORD IS ACCEPTED IF USER HAS ANY OF THE PRIVS.
LANOK==400 ;LEFT ANGLE BRACKET ACCEPTABLE AFTER THIS WORD
INVIS==1000 ;DO NOT LIST THIS ENTRY'S KEYWORD WHEN "?" IS TYPED
;(TESTED IN %Z IN ETYPE)
;ALL BITS NOW IN USE -- UG !-- 8/28/70
;ONEWD NOCONF CONMAN ALTCON NOLOG PROGX EASUB CONFRC
;BITS IN LH VALUE WORD IN KEYWORD TABLES...
;THE REST OF THE BITS ARE NOT TESTED BY %KEYW.
;THIS NEXT GROUP ARE USED IN THE MAIN COMMAND TABLES, AND ARE
; MOVED TO AC "KWV1" AFTER FIRST KEYWORD IS INPUT, AND
; STAY IN KWV1 THROUGHOUT COMMAND DECODING.
;SEVERAL ALSO USED IN SUBCOMMAND TABLES
;SUBROUTINE "CONF" LOOKS AT SEVERAL OF THESE.
ONEWD==400000 ;ONE WORD COMMAND: CONFIRM BEFORE DISPATCH,
; "EOLOK" BIT IMPLIED
NOCONF==200000 ;THIS COMMAND REQUIRES NO CONFIRMATION
CONMAN==100000 ;CONFIRMATION IS MANDATORY FOR THIS COMMAND
ALTCON==40000 ;ALT MODE MAY BE USED TO CONFIRM THIS COMMAND
;(EOL ECHOED)
NOLOG==20000 ;THIS COMMAND LEGAL EVEN IF NOT LOGGED IN
PROGX==10000 ;RUN A PROGRAM WHICH WILL APPEAR AS AN
; EXTENTION TO THE EXEC. THIS BIT IS NEVER ON IN
; COMMAND TABLE ENTRIES. IT IS TURNED ON BY THE EXEC
; WHEN IT DECIDES THAT A FILE NAME SHOULD LOOK LIKE
; AN EXEC COMMAND.
;ALSO B5 USED IN "CREATE" SUBCOMMAND TABLE
EASUB==4000 ;THIS COMMAND EXAMINES, ALTERS, OR EXECUTES SUBSIDIARY
; FORK, AND IS THUS ILLEGAL IF A PROPRIETARY
; PROGRAM IS IN THAT FORK.
CONFRC==2000 ;CONFIRMATION IS FORCED FOR THIS COMMAND
;THE FOLLOWING ARE SOME OF THE OTHER BITS USED IN VARIOUS OTHER TABLES.
;DO NOT REDEFINE THESE BITS OR THOSE IN GROUP INTERPRETED BY
; "%KEYW" IN SUCH A WAY AS TO PRODUCE A CONFLICT!
;B5 ALSO USED IN "CREATE" SUBCOMMAND TABLE (5/14/70).
;PUNCF STCF CTRLVF BAKFF DASHF NECHOF RUNF CTLCF1 CTLCF2 LOGOFF DTACHF NEOLF EOLNEF GROUPF F3 F2 F1
;FLAG BITS IN AC Z LEFT HALF
;THESE FLAGS ARE CLEARED BEFORE EACH COMMAND IS DECODED
PUNCF==1 ;PUNCTUATION OTHER THAN FILE NAME FIELD TERMINATORS
; OK IN INPUT FIELDS.
; TESTED IN "CSTR" SUBROUTINE.
STCF==2 ;STORE CHARACTERS WHICH ARE OUTPUT WITH SUBR "CCHRO"
;(AND HENCE MACRO "TYPE") INTO CBUF (POINTER "CBP").
;USED WHILE REST OF WORD IS BEING TYPED AFTER ALT MODE.
CTRLVF==4 ;THIS CHARACTER WAS PRECEDED BY ↑V
;SET IN "CCHRI", TESTED IN "CSTR"
BAKFF==10 ;BACK UP A FIELD (UN-INPUT FIELD): CAUSES CSTR SUBR AND
; KEYWD UUO TO RE-USE THE PREVIOUS INPUT FIELD.
DASHF==20 ;"-" A TERMINATOR NOT "ALPHANUMERIC" CHARACTER
NECHOF==40 ;ECHOING OFF (PASSWORD INPUT). TESTED IN %NOI.
RUNF==100 ;PROG RUNNING (OR AT LEAST ITS TTY MODES IN EFFECT)
;ALSO TELLS ↑C TO FREEZE THE WORLD (5/20/70).
CTLCF1==200 ;SET BY ↑C TO SAY CLEAR BUFFER ON ANOTHER ↑C
CTLCF2==400 ;SET BY 2ND ↑C TO SAY CLEAR BUFFER AFTER DEBREAK
LOGOFF==1000 ;SET DURING LOGOUT MESSAGE AND LOGGING OUT PROCESS.
;TELLS ERRORS AND ↑C TO SAY "NOT LOGGED OUT".
DTACHF==2000 ;INDICATES "DETACH" COMMAND.
;DISTINGUISHES IT FROM "REDIRECT" AND OTHER COMMANDS
;DURING EXECUTION.
NEOLF==4000 ;TELLS CSTR AND OTHER ROUTINES NOT TO ECHO INPUT EOL'S.
;USED WHEN A FILE NAME IS BEING PRE-READ.
EOLNEF==10000 ;SAYS AN EOL HAS BEEN INPUT BUT NOT ECHOED.
GROUPF==20000 ;ON IF INFG ETC INPUT A GROUP OF INPUT FILE NAMES
;(A NAME WITH AN *, OR MORE THAN ONE NAME)
F3==40000 ;FLAG AVAILABLE FOR USE IN COMMANDS,
;NOT CLOBBERED BY UUO'S OR SUBROUTINES.
F2==100000 ;ANOTHER FLAG AVAILABLE FOR USE IN COMMANDS
F1==200000 ;FLAG AVAILABLE FOR LOCAL USE IN SUBRS AND UUO'S
;FLAG BITS IN AC Z RIGHT HALF ARE ALSO AVAILABLE TO COMMAND ROUTINES.
;B0 B1 B2 B3 B4 B5 B6 B7 B8 B9 B10 B11 B12 B13 B14 B15 B16 B17 NSBUF BUF1 BUF2
;GENERAL PURPOSE BIT SYMBOLS
;USED, FOR INSTANCE, IN JSYS CALLING SEQUENCES
B0==400000
B1==200000
B2==100000
B3==40000
B4==20000
B5==10000
B6==4000
B7==2000
B8==1000
B9==400
B10==200
B11==100
B12==40
B13==20
B14==10
B15==4
B16==2
B17==1
;LOCATIONS OF SOME PAGE BUFFERS
;PAGE-MAPPING BUFFERS ARE BETWEEN 747000 AND 767777.
NSBUF=747000 ;WINDOW INTO NETWORK STATISTICS FILE
BUF1=750000 ;"COPY" COMMAND SOURCE PAGE
;ALSO BUF1 AND FOLLOWING PAGES ARE USED BY "DIRECTORY"
BUF2=751000 ;"COPY" COMMAND DESTINATION PAGE
;PAGEN==1000 ;IS ASSEMBLED INTO XPRIV.MAC.
;Z A B C D E F G AA BB CC DD EE FF GG P CALL RET
;************* TENEX SYSTEM STANDARD DEFINITIONS *************
;AC'S
Z=0
A=1
B=2
C=3
D=4
E=5
F=6
G==7
AA==10
BB==11
CC==12
DD==13
EE==14
FF==15
GG==16
P=17 ;PUSHDOWN POINTER
OPDEF CALL [PUSHJ P,]
OPDEF RET [POPJ P,]
;.P .JBUFP JBUFP JBUF INIFH1 INIFH2 EOFDSP ILIDSP ERRMF
SUBTTL PDP-10 TENEX EXECUTIVE PRIVATE STORAGE AREA
LOC 140
;STORAGE FOR EXEC COMMAND INTERPRETER
CSZ1==. ;CSZ1 TO CSZ2 IS ZEROED EVERY COMMAND
.P: Z ;P SAVED AT BEGINNING OF SUBCOMMAND, FOR %ERR TO RESTORE
.JBUFP: Z ;JBUFP SAVED AT BEGINNING OF SUBCOMMAND
JBUFP: Z ;PUSHDOWN-TYPE POINTER INTO...
JBUF: BLOCK JBUFL ;BUFFER (STACK) FOR JFN'S. JFN'S OF ALL FILES
;MENTIONED IN A COMMAND MUST BE HERE SO ERROR ROUTINES
;CAN CLOSE AND RELEASE THEM.
CJFN1==JBUF ;JFN OF FIRST ARGUMENT
CJFN2==JBUF+1 ;JFN OF 2ND ARGUMENT
INIFH1: Z ;JBUFP VALUE FOR FIRST JFN IN INPUT FILE GROUP
INIFH2: Z ;SAME FOR LAST FILE. SAME AS INIFH1 UNLESS SEVERAL
;NAMES (SEPERATED BY COMMAS) WERE GIVEN.
EOFDSP: Z ;SPECIAL DISPATCH ADDRESS FOR EOF PSI, EG DURING "COPY"
ILIDSP: Z ;0 OR SPECIAL DISPATCH FOR ILLEG INSTRUCTION TRAP
ERRMF: Z ;NON-ZERO WHILE PROCESSING ERROR
;CURTAILS PROCESSING OF NESTED ERRORS TO AVOID
;INFINITE LOOPS IN ERROR CODE.
CSZ2==.-1 ;END OF AREA ZEROED EVERY COMMAND
;CINITF STRTAC AUTFLG APJFN DTSF PRVENF PROPSF MESMSF MSGTIM LOCAL DOT CUSRNO FORK LRFORK IDFORK DBFORK UFORK DDTFLG NPAGE EFORK XFORK STRTIM TTYACF ALOFH PTTYMD ETTYMD SUPSUB CTLIM0 CTLIM1
CINITF: Z ;NON-ZERO AFTER STARTUP INITIALIZATION COMPLETED
STRTAC: REPEAT 20,<Z
>
AUTFLG: Z ;JFN FOR AUTOSTARTUP JOBS, 0 OTHERWISE
APJFN: Z ;PRIMARY IO FOR AUTOSTARTED FORK
DTSF: Z ;NON-0 IF SYSTEM DATE & TIME HAVE BEEN SET
PRVENF: Z ;NON-0 IF PRIVILEGED COMMANDS "ENABLE"D
PROPSF: Z ;NON-0 IF INFERIOR IS A PROPRIETARY SUBSYSTEM.
;DISABLES /, \, GOTO, SAVE, ETC.
;NOTHING SETS THIS YET (6/9/70), SHD BE SET IN "GET"←←←←
MESMSF: Z ;MESSAGE FLAG: NON-0 SAYS TO LOOP TO TYPE
;"YOU HAVE A MESSAGE" IF APPROPRIATE
MSGTIM: Z ;"TIME" DEADLINE OF NEXT MAIL CHECK, OR -1 IF
;MAIL CHECK IS OFF.
LOCAL: Z ;NON-ZERO IF THIS IS A LOCAL TERMINAL
TTCTY==20 ;CTY LINE - ABOVE THIS ARE PTY'S
DOT: Z ;"." FOR DDT-TYPE EXEC COMMANDS
CUSRNO: Z ;USER # IF LOGGED IN, 0 IF NOT
FORK: Z ;-1 OR HANDLE OF INFERIOR FORK EXEC CURRENTLY KNOWS OF.
;SET BY GET, RUN, FORK N, ETC.
;USED BY START, /, \, GOTO, ETC.
LRFORK: Z ;-1 OR HANDLE OF FORK LAST RUN.
;SET BY START, REENTER, GOTO, RUN, SUBSYS CALL.
;USED BY CONTINUE.
IDFORK: Z ;-1 OR FORK HANDLE OF IDDT
;;; BDFORK: Z ;-1 OR FORK HANDLE OF BDDT
DBFORK: Z ;POINTS TO EITHER IDFORK OR BDFORK
UFORK: Z ;-1 OR HANDLE OF USER UNDER IDDT, BDDT
DDTFLG: Z ;-1 IF DDT HAS BEEN MERGED INTO SUBSIDIARY FORK
NPAGE: Z ;-1 OR XWD FORK HANDLE, ADDR FOR PAGE MAPPED AT "PAGEN"
EFORK: Z ; EPHEMERON FORK HANDLE
XFORK: Z ;FORK HANDLE FOR SPECIAL INFERIOR EXEC FORK
;AUTOLOGOUT CRAP
STRTIM: Z ;DATE AND TIME EXEC WAS STARTED, IN "GTAD" FORMAT
TTYACF: Z ;TTY ACTIVITY FLAG: AOS'D FOR EACH CHARACTER IN OR OUT
ALOFH: Z ;AUTOLOGOUT FORK HANDLE, OR 0 IF NEVER STARTED, OR
;-1 IF ALREADY KILLED.
;2 BLOCKS CONTAINING TTY MODE WORD, TAB STOPS (3 WORDS),
; CONTROL CHARACTER OUTPUT CONTROL INFO (CCOC) (2 WORDS)
; TERMINAL INTERRUPT WORDS (2 WORDS)
; SUBSYTEM NAME (1 WORD)
; PROGRAM'S VALUES: SAVED ON ↑C, RESTORED ON CONTINUE.
PTTYMD: BLOCK NTTYMD
; EXEC'S VALUES: USED DURING COMMAND INPUT.
ETTYMD: BLOCK NTTYMD
SUBSYS=PTTYMD+10 ;SUBSYSTEM NAME IN SIXBIT
;SUPERIOR'S SUBSYSTEM NAME, RESTORED BY "QUIT"
SUPSUB: Z
;FOR CONTROL T ROUTINE
CTLIM0: Z ;DELTA1 (15 SEC) PLUS TIME OF 1ST ↑T
CTLIM1: Z ;DELTA2 (1 MIN) PLUS TIME OF LAST VERBOSE ↑T TYPEOUT
;PRIMRY CIJFN COJFN CRJFNI CRJFNO CREDIF CREDOF CERET CTUUO CSTRR FRSTFR %EDAYT CSBUFP ERCOD ERPC DWNMSF
PRIMRY: Z ;SAVED PRIMARY JFNS AT ENTRY
CIJFN: Z ;COMMAND (PRIMARY) INPUT JFN
COJFN: Z ;PRIMARY OUTPUT JFN
;PRIMARY INPUT AND OUTPUT JFN'S SAVED AT ↑C OUT OF REDIRECTED I/O
; OPERATION. EACH OF THESE IS SIGNIFICANT ONLY IF CORRESPONDING
; FLAG IS -1.
CRJFNI: Z
CRJFNO: Z
;INPUT AND OUTPUT REDIRECTION FLAGS.
;EACH CAN INDEPENDENTLY HAVE THE VALUES:
; 0 NORMAL
; -1 INPUT OR OUTPUT IS NOW REDIRECTED
; 1 ↑C'D (OR ERRORED?) OUT OF REDIRECTION,
; JFN OF LAST USED REDIRECT FILE IN CRJFNI/O.
CREDIF: Z
CREDOF: Z
CERET: Z ;WHERE TO GO AFTER ERROR MESSAGE. NORMALLY "RERET"
;WHICH GOES BACK TO CMDIN, BUT IS CHANGED DURING SUB-CMD
;INPUT AS FOR "DIRECTORY"
CTUUO: Z ;TEMPORARY FOR UUO DISPATCHER
CSTRR: Z ;USED BY "CSTR" TO SAVE RETURN FOR "MORE"
FRSTFR: Z ;RETURN FROM "FRSTF" SUBR IN XSUBRS.MAC, SAVED FOR USE
;BY "NEXTF", ALSO IN XSUBRS.MAC
%EDAYT: Z ;DATE & TIME SAVED FROM %D TO %E (ETYPE UUO, XSUBRS.MAC)
CSBUFP: Z ;POINTER INTO CSBUF (SEE SAME)
ERCOD: Z ;ERROR CODE FROM JSYS ERROR RETURN OR FAKE ITRAP
ERPC: Z ;PC FOR FAKE INSTRUCTION TRAP FOR SIMULATED JSYS'S
DWNMSF: Z ;-1 OR "TIME" OF NEXT DOWNTIME CHECK
;DOWNTM UPTIME WHYHLT FRAME IUSRNM EDFILE DEVICE DIRNO OLDDIR OUTDSG INDSG LPNAME LPEXT LPFDB LFPOS GHEAD HEAD HEDLNO SPCG WIDTH LENGTH L35 L50 PAGENO PAGEN1 BESPTR BESCOR BESLNO PPRINT LEV1PC LEV2PC LEV3PC
;STORAGE FOR "HALT"
DOWNTM: Z
UPTIME: Z
WHYHLT: Z
;STORAGE USED BY TTYNUM FOR "LINK" AND "ADVISE"
FRAME: Z ;P SAVED DURING TTYNUM
;STORAGE USED BY SUBSYS LOOKUP
IUSRNM: BLOCK ↑D10
;STORAGE USED BY "EDIT"
EDFILE: BLOCK EDFILL ;HOLDS NAME OF FILE BEING EDITTED
;STORAGE LOCATIONS USED BY "DIRECTORY" AND OTHER COMMANDS FOR
; INFORMATION ABOUT ARGUMENTS
DEVICE: Z ;DEVICE IDENTIFIER
DIRNO: Z ;DIRECTORY NUMBER
OLDDIR: Z ;PREVIOUS DIRECTORY NUMBER
OUTDSG: Z ;DESIGNATOR OF FILE TO PRINT ON
INDSG: Z ;SOURCE JFN (TYPE, LIST)
;EXECUTION TIME STORAGE FOR "DIRECTORY" AND OTHER COMMANDS
LPNAME: Z ;0 OR STRING POINTER TO LAST PRINTED NAME
LPEXT: Z ;0 OR STRING POINTER TO LAST PRINTED EXTENSION
LPFDB: Z ;0 OR LOCATION OF FDB FOR WHICH PRINTING IS INCOMPLETE
LFPOS: Z ;LINE POSITION, AS - # COLS USED OVER MINIMUM
;STORAGE FOR "LIST" AND "TYPE" COMMANDS
GHEAD: Z ;0 OR BYTE POINTER TO SUBCOMMAND-GIVEN HEADING
HEAD: Z ;0 OR PTR TO HEAD BEING USED FOR THIS FILE, INCL "PAGE "
HEDLNO: Z ;# LINES IN HEADING, INCL EOLS BEFORE AND AFTER
SPCG: Z ;0 FOR SINGLE SPACING, 1 FOR DOUBLE, ETC
WIDTH: Z ;PAGE WIDTH IN COLUMNS
LENGTH: Z ;PAGE LENGTH IN LINES
; = LAST LINE AT WHICH TO BREAK PAGE IF NO ↑L
L35: Z ;FIRST LINE AT WHICH TO BREAK PAGE IN ABSENCE OF ↑L
L50: Z ;PREFERRED LINE AT WHICH TO BREAK PAGE
PAGENO: Z ;PAGE NUMBER, INCREMENTED AT ↑L
PAGEN1: Z ;SUBPAGE NUMBER, INCREMENTED WHEN OVERLONG PAGE IS SPLIT
BESPTR: Z ;POINTER TO BEST PLACE IN OUTBUF YET SEEN TO BREAK PAGE
BESCOR: Z ;"SCORE" ASSOCIATED WITH BESPTR
BESLNO: Z ;LINE # AT BESPTR
PPRINT: Z ;POINTER TO BLOCK OF WORDS SPECIFYING PAGES TO LIST,
;EACH WORD BEING XWD MIN,MAX, 0 TERMINATING BLOCK.
;PSEUDO-INTERRUPT PC STORAGE WORDS
LEV1PC: Z
LEV2PC: Z
LEV3PC: Z
;PD CBUF CBUFE CWBUF CJFNBK CSBUF CSBUFE PPATS SGTNAM SGTAC1 SGTAC2 PAGEN
;BUFFERS
PD: BLOCK PDL ;PUSHDOWN
;WHILE A PUSHDOWN OVERFLOW ERROR MESSAGE IS BEING
; TYPED PD OVERFLOWS INTO CBUF, WHICH IS OK.
CBUF: BLOCK CBUFL ;BUFFER FOR ENTIRE COMMAND TEXT,
;INCLUDING STUFF ECHOED BY ALT MODE.
CBUFE: Z ;END OF CBUF
CWBUF: BLOCK 4 ;BUFFER IN WHICH TO SET UP WORD JUST SO
;FOR "FSYM" TABLE SEARCH.
CJFNBK: BLOCK 11 ;ARGUMENT BLOCK FOR "GTJFN" JSYS
;ALWAYS ALL 0 EXCEPT WORDS 0, 1, 3, 4, 5.
CSBUF: BLOCK CSBUFL ;BUFFER IN WHICH TO SET UP AND SAVE STRINGS
;USED AS JSYS ARGUMENTS (BUFFF SUBR),
LOC .!777-40 ;USE REST OF PAGE EXCEPT FOR PATCH AREA
CSBUFE: ;END OF CSBUF. EVEN IF STRINGS OVERFLOW BEYOND
;THIS POINT IT USUALLY WON'T DO ANY HARM.
PPATS: PPAT: BLOCK 40 ;PRIVATE PATCH AREA
LOC .!777+1001-3*SGTBLN ;LOCATE HASH TABLES AT TOP OF NEXT PAGE
SGTNAM: BLOCK SGTBLN ;HOLDS SIXBIT NAME (ARGUMENT TO SYSGT)
SGTAC1: BLOCK SGTBLN ;HOLD AC1 RETURNED BY SYSGT
SGTAC2: BLOCK SGTBLN ;HOLDS AC2 RETURNED BY SYSGT
CSZ4==.-1 ;END OF AREA TO ZERO AT STARTUP (BEGINS AT CSZ1)
;BUFFERS FOR MAPPING PAGES
LOC <.+777>&777000 ;SET LOCATION TO NEXT PAGE BOUNDARY
;IF NOT ALREADY THERE
PAGEN: BLOCK ↑D512 ;POSSIBLE PAGE MAPPED FOR EXAMInE, DEPOSIT, ETC.
;OR LOOKING AT JOBDAT.
;IF A PAGE IS MApPED HERE "NPAGE" IDENTIFIES IT.
;EXEC ..JBSYM ..JBUSY VERTXT VERSN PATVER PATS CUUOT CUUO
SUBTTL PDP-10 TENEX EXECUTIVE
; 10/50 JOB DATA AREA
.JBSYM=116
.JBUSY=117
.JBSA=120
.JBREN=124
.JBOPC=130
.JBERR=42
;TENEX ENTRY VECTOR
;N.B. "EXEC" MUST BE THE FIRST SYMBOL IN RELOC SECTION
EXEC: JRST REE ;START ENTRY
JRST REE ;REENTER ENTRY
JRST AUTOST ;AUTO STARTUP ENTRY
EVECL==.-EXEC
;POINTERS TO DEFINED AND UNDEFINED SYMBOL TABLES
;SAVED HERE FROM .JBSYM AND .JBSYM WHEN THOSE PAGES ARE
; REMOVED FOR SHARABLE SUBSYSTEM
..JBSYM: 0
..JBUSY: 0
;EXEC VERSION, PRINTED ON STARTUP AND BY "VERSION" COMMAND
; NOTE THESE GET SETUP AUTOMATICALLY FROM THE EXTENSION OF
; <SYSTEM>EXEC.SAV;0 WHEN STARTED THE FIRST TIME AFTER A
; REASSEMBLY. (NOTE: THE INPUT COMMAND FILE DOES THIS TO MOVE
; SYMBOL POINTERS ALREADY).
VERTXT: ASCIZ / Exec 1.54/ ;MAJOR AND MINOR VERSIONS
VERSN: ↑D154
PATVER: 0 ;# TIMES PATCHED
;PATCH AREA
PATS: PAT: BLOCK 200
;UUO DISPATCH TABLE
CUUOT: EXP 0,%ERR,%TYPE,%KEYW
EXP %NOI,%$TYPE,%ALLOW
EXP %ALTYP,%$ERR,%ETYPE,%GTB
EXP %PRINT,%TRAP,%.$ERR,%INHEL
EXP %SBCOM
;UUO DISPATCHER
CUUO: MOVEM A,CTUUO
HLRZ A,40
LSH A,-↑D9
HRRZ A,CUUOT(A)
EXCH A,CTUUO
JRST @CTUUO
;.VERSI VERSI1 VERSI2 CMD2A3
;SUBROUTINE TO TYPE SYSTEM AND EXEC VERSIONS.
;USED AT STARTUP TO PRINT SIGN-ON HEARLD, AND IS ALSO THE
; EXECUTION ROUTINE FOR "VERSION" COMMAND.
.VERSI: PRINT " "
MOVE A,[SIXBIT /SYSVER/]
CALL $SYSGT ;SYSTEM NAME AND VERSION
HLLZ D,B ;LENGTH,,INDEX
HRRZ E,B ;TABLE #
VERSI1: GTB (E) ;GET A DATA WORD FROM TABLE (USES D)
MOVE B,A
MOVEI C,5 ;PRINT 5 CHARS FROM EACH WORD
SETZ A,
LSHC A,7
JUMPE A,VERSI2 ;END ON NULL
PRINT (A)
SOJG C,.-4
AOBJN D,VERSI1 ;ALSO END ON END OF TABLE
;"EXEC" AND ITS VERSION
VERSI2: UTYPE VERTXT ;VERSION TEXT
SKIPN B,PATVER
JRST CMD2A3 ;DON'T PRINT # PATCHES IF NONE
PRINT "."
MOVE A,COJFN
MOVEI C,↑D10 ;DECIMAL OUTPUT
NOUT
CALL JERRC ;ERROR, NUMBER IN C
CMD2A3: PRINT EOL
RET
;AUTOST AUTO0 REE
;AUTOSTARTUP ENTRY
AUTOST: SETZM CSZ1 ;ZERO WRITABLE PAGE
MOVE C,[CSZ1,,CSZ1+1]
BLT C,CSZ4
MOVEM A,APJFN ;PRIMARY IO FOR AUTOSTARTED FORK
MOVEM B,AUTFLG ;USE JFN AS FLAG FOR AUTOSTARTUP JOB
AUTO0: MOVE P,[IOWD PDL,PD]
CALL INFER
SETOM 0
AOS 0
MOVEM STRTAC
JRST EXEC0A
;REENTER ENTRY
REE: SKIPE CINITF ;IS EXEC INITIALIZED?
JRST EXEC0B
;EXEC0 EXEC0A EXEC06
;EXEC COMMAND INTERPRETER IS INITIALLY STARTED HERE
EXEC0:
;ZERO WRITEABLE PAGE
SETZM CSZ1
MOVE A,[CSZ1,,CSZ1+1]
BLT A,CSZ4
;SET UP 41 FOR UUO'S, P=17 FOR PUSHDOWN POINTER
EXEC0A: MOVE A,[CALL CUUO]
MOVEM A,41
MOVE P,[IOWD PDL,PD]
;CLEAR FLAGS
SETZ Z,
;RANDOM THINGS
SETOM FORK ;SAY NO INFERIOR FORK
SETOM LRFORK ;SAY NO FORK HAS BEEN RUN
SETOM IDFORK ;SAY NO IDDT FORK
;; SETOM BDFORK ;SAY NO BDDT FORK
SETOM UFORK ;SAY NO FORK UNDER IDDT, BDDT
SETOM EFORK ;SAY NO EPHEMERAL FORK
SETOM XFORK ;SAY NO EXEC FORK
SETOM NPAGE ;SAY NO PAGE OF INFERIOR IS MAPPED
SETOM MSGTIM ;DO "MAIL WATCH OFF" (DEFAULT)
; SETOM PRNTIM ;DO "PRINTER WATCH OFF" (DEFAULT)
MOVE A,[EDFILE+1,,EDFILE+2]
MOVEM A,EDFILE
MOVE A,[ASCIZ /MAC/]
MOVEM A,EDFILE+2
; HERE GOES SPECIAL CASE INITIAL FILENAMES/EXTENSIONS
;ON FIRST STARTUP, MOVE SYMBOL TABLE POINTER INTO ONE OF THE CODE PAGES,
; SO IT WILL BE KEPT THRU SHARABLE SAVES.
MOVE C,.JBUSY ;10/50 UDEFINED POINTER
SKIPE D,.JBSYM ;GET 10/50 STYLE PTR, SKIP IF NONE.
SKIPE ..JBSYM ;NO SKIP IF ALREADY MOVED
JRST EXEC0B ;NO PTR OR ALREADY MOVED
MOVE A,[400000,,<..JBSYM/1000>]
RPACS ;READ PAGE ACCESSIBILITY
TLNN B,(1B3!1B9) ;..JBSYM WRITE-PROTECTED?
JRST EXEC0B ;YES
MOVEM D,..JBSYM ;NO, STORE SYMBOL TABLE POINTER.
MOVEM C,..JBUSY ;AND UNDEFINED POINTER
;NOW SETUP THE VERSION NUMBERS
;EXEC05: MOVSI 1,(1B2!1B17) ;OLD, SHORT
; HRROI 2,[ASCIZ /<SYSTEM>EXEC.SAV/]
; GTJFN
; JRST EXEC0B ;CANNOT DO IT, DOESN'T MATTER.
; MOVE 2,[1,,FDBVER]
; MOVEI 3,3
; GTFDB
; HLRZS 3 ;GET VERSION NUMBER
; IDIVI 3,↑D100 ;SPLIT OFF THE PATCH NUMBER
; ADDI 4,1
; CAMN 3,VERSN ;NEW VERSION OF OLD PROGRAM?
; MOVEM 4,PATVER ;YES, SAVE INCREMENTED PATVER
; RLJFN
; JFCL
;
;;NOW SET THE ENTRY VECTOR
EXEC06: MOVEI 1,400000 ;THE EXEC FORK
MOVE 2,[EVECL,,EXEC]
SEVEC ;IN CASE NEW "LOADER" NOT USED
EXEC07: MOVE 1,VERSN
IMULI 1,↑D100
ADD 1,PATVER
HRLI 1,(1B0!1B17) ;FOR OUTPUT, SHORT
HRROI 2,[ASCIZ /EXEC.SAV/] ;IN CONNECTED DIRECTORY
GTJFN
JRST EXEC0B
HRLI 1,400000 ;FORM FORK,,JFN
MOVEI 2,EXEC ;MACRO CANT TO DIVISION WITH RELOC'S
IDIVI 2,1000 ;FIRST PAGE TO SSAVE
MOVEI 3,520000(2) ;RCX BITS
SUBI 2,100 ;DO THROUGH PAGE 77
HRLZS 2 ;NEGATIVE PAGE COUNT
HRR 2,3
SETZ 3,
SSAVE
HALTF
;EXEC0B
EXEC0B:
;SET UP PRIMARY INPUT AND OUTPUT JFN'S
;THESE REMAIN CONSTANT AT LEAST AT PRESENT.
MOVEI 1,400000
GPJFN
MOVEM 2,PRIMRY ;SAVE FOR ↑C, ERRORS ETC
MOVEI A,100
MOVEM A,CIJFN
MOVEI A,101
MOVEM A,COJFN
;INITIALIZE PROCESS PSI SYSTEM,
; DONE EARLY SO ERRORS IN REST OF INITIALIZATION WILL BE HANDLED.
;ENABLE ALL ERROR CHANNELS BUT OVERFLOW,
; ALSO CHANNEL 1 FOR ASSIGNMENT TO ↑C BELOW,
; AND 2 FOR AUTOLOGOUT.
MOVEI A,B0 ;SAY THIS FORK
MOVE B,[LEVTAB,,CHNTAB]
SIR ;SET UP TABLE ADDRESSES
MOVE B,[360777500000] ;CHANNELS 1-4,9-18, 20.
AIC ;ACTIVATE SPECIFIED CHANNELS
EQV B,[1B0+1B19];DON'T CHANGE CHANS USED BY MINI-EXEC. 4/30/70.
;ABOVE FOR DEBUGGING . SETCA B, TO DEACTIVATE ALL.
DIC ;DEACTIVATE ALL OTHERS
EIR ;ENABLE PROCESS PSI SYSTEM
;EXEC0C
;INITIALIZE THE EXEC AND PROGRAM TTY MODE BLOCKS
; WORD-0 OF PTTYMD IS USED AS FLAG TO INDICATE WHETHER OR NOT WE
; HAVE A TTY. CALLS TO LTTYMD OPERATE ONLY ON SUBSYS
; NAME IF WORD-0 IS ZERO. THIS WILL BECOME NON-ZERO AS
; SOON AS WE HAVE A TTY. NOTE: THIS CAN HAPPEN HERE, IF
; THE "GET" DURING AUTOSTARTUP IS BAD, OR IN RTTYMD
; DUE TO ↑C OUT OF AUTOSTARTED JOB WHICH WAS STARTED DETACHED.
EXEC0C: GETNM ;SUPERIOR-SET SUBSYS NAME
MOVEM 1,SUPSUB ;SAVE FOR "QUIT"
MOVE A,[INETTY,,ETTYMD] ;INITIAL EXEC MODES
BLT A,ETTYMD+NTTYMD-1 ;INCLUDING MODIFIED CCOC, TIW AND SUBSYS
MOVE A,[INPTTY,,PTTYMD] ;INITIAL TTY FOR USER
BLT A,PTTYMD+NTTYMD-1 ;JUST A NORMAL TTY
GJINF
CAMN 4,[-1] ;ARE WE DETACHED?
JRST CMDIN1 ;YES, LEAVE 0 IN ETTYMD, PTTYMD
MOVE 2,[1B3+↑D66B10+↑D72B17+17B23+2B25+1B26+1B29+1B31]
MOVEM 2,ETTYMD+0
MOVEM 2,PTTYMD+0
;CMDIN1 CMDIN2 ERRET
CMDIN1: SKIPE CINITF ;ARE WE INITIALIZING?
JRST CMDIN2 ;NO, NO SIGN-ON HEARLD
SKIPN AUTFLG ;NO HERALD FOR AUTOSTARTUP JOBS
TLOA Z,F1 ;SAY PRINT SIGN-ON HEARLD
;COMMANDS THAT RUN PROGRAM RETURN HERE WHEN IT STOPS.
;START, CONT, REENTER, RUN, ERUN, <SUBSYSTEM NAME>, GOTO.
;RE-ENTRY JOINS MAIN FLOW HERE
CMDIN2:
;↑C AND COMMAND ERRORS COME BACK HERE.
;AFTER ↑C IT IS NECESSARY TO EXECUTE CODE TO FIND OUT WHETHER LOGGED IN,
; HAVE INFERIOR FORK, UPDATE CAPABILITIES, KILL AUTOLOGOUT FORK,
; ETC IN CASE INTERRUPTED COMMAND WAS LOGIN, RUN, ETC.
ERRET: TLZ Z,F1 ;SAY NO SIGN-ON MESSAGE
;MAKE SURE ↑C PSI CHANNEL ACTIVATED
; (IT IS TURNED OFF DURING PART OF "LOGIN" AND "RESET")
MOVEI A,B0
HRLZI B,B1
AIC
MOVEI E,ETTYMD ;PUT EXEC'S TTY MODES INTO EFFECT
CALL LTTYMD ;IF THEY EXIST. SETNM, TOO.
MOVEI A,RERET ;SAY WHERE TO GO ON ERROR WHILE TYPING
MOVEM A,CERET ; ...LOGIN MESSAGE
TLZN Z,F1 ;SIGN-ON MESSAGE, FIRST TIME ONLY
JRST CMDN2B ;NO
PRINT EOL
CALL .VERSI ;PRINT SYSTEM AND EXEC VERSIONS
HRLZI A,B0!B1 ;"FACT FILE OR LOGGING TTY" ENABLED
TMON ;SKIP IF EITHER EXISTS
JRST [ UTYPE [ASCIZ / *****ACCOUNTING OFF*****
/]
JRST .+1]
CALL LGNCHK ;WARN IF LOGINS PROHIBITTED
JUMPE A,CMDN2B ;LGNCHK SAID OK TO LOGIN
CALL CRIF
TYPE <Attach to existing job is permitted>
PRINT EOL
;CMDN2B CMDN2C
;SAY INITIALIZATION HAS COMPLETED SUCCESSFULLY.
;UNTIL CINITF><0, ERROR ROUTINES HALT RATHER THAN TYPE MESSAGES,
; AND "REENTER" DOES A "START".
CMDN2B: SETOM CINITF
;FIND OUT IF THIS JOB IS LOGGED IN. (MIGHT BE AT STARTUP IF SUBSIDIARY,
; OR A SUBSYSTEM COULD LOG JOB IN.)
GJINF ;LOGIN DIR # IN A, 0 IF NOT LOGGED
MOVEM A,CUSRNO ;SAVE LOGIN DIR # OR -1
SETZM LOCAL ;TTY LINE # IS IN D
MOVE A,[SIXBIT \LOCAL\]
SYSGT
TRNN B,-1
JRST CMDN2C
HRRZ A,B
HRL A,D
GETAB
JRST CMDN2C
JUMPL A,CMDN2C ;NOT A LOCAL TERMINAL
SETOM LOCAL
PUSH P,A ;.RAISE SMASHES "A"
CAILE A,2 ;TERMINAL TYPES 0-2 USE ALTMODE
CAIN A,10 ;SO DOES 10 (LA30)
CALL .RAISE
POP P,A
PUSH P,[CMDN2C] ;SUBROUTINE RETURN
HLRZ C,TRMTAB(A) ;GET PAGE LENGTH
PUSH P,C
HRRZ C,TRMTAB(A) ;GET PAGE WIDTH
PUSH P,C
MOVE A,COJFN
JRST SCOPE2 ;SET THEM
;KILL AUTOLOGOUT FORK IF IT EXISTS BUT LOGGED IN.
CMDN2C: SKIPLE CUSRNO ;SKIP IF NOT LOGGED IN
SKIPG A,ALOFH ;FORK THAT LOGS OUT ABANDONED JOBS
JRST .+3
SETOM ALOFH ;SAY ITS KILLED (DON'T RETRY ON FAILURE)
KFORK ;KILL IT
;CMDN2D
;ENABLE SPECIAL CAPABILITIES
CMDN2D: MOVEI A,B0 ;SAY THIS FORK
RPCAP ;GET SPECIAL CAPABILITIES POSSIBLE IN 2
HLLZ C,B ;ENABLE ALL PROCESS (LH) CAPABILITIES
SKIPE PRVENF ;IF "ENABLE" COMMAND IS IN EFFECT,
HRR C,B ;ALSO ENABLE RH (USER) CAPABILITIES.
EPCAP
MOVEI 1,400000
CIS
MOVE A,[CTRLC,,1]
TLNE C,B0 ;TEST SPEC CAP BIT 0
ATI ;ASSIGN ↑C TO CHAN 1
MOVE A,[CTCODE,,3]
ATI ;ASSIGN ↑T TO CHAN 3
MOVE A,[HUCODE,,4]
ATI ;ASSIGN CARRIER OFF TO CHAN 4
;PRINT "YOU HAVE A MESSAGE" IF APPROPRIATE
;HERE SO DONE EVEN AFTER ↑C DURING LOGIN MESSAGE
SKIPE MESMSF ;SKIP IF WE NEEDN'T CHECK FOR A MESSAGE
;(NON-0 FROM LOGIN TO SUCCESSFUL
;COMPLETION OF "MESMES")
CALL MESMES ;SUBROUTINE NEAR "LOGIN"
JFCL ;ALSO PRINTS DSK ALLO. EXCD.
;AND PENDING SHUDOWN TIME
;CMDIN4
;HERE WHEN READY TO INPUT A COMMAND.
;ALL COMMANDS RETURN HERE OR ABOVE HERE WHEN DONE.
CMDIN4: MOVEI E,ETTYMD
CALL LTTYMD ;IN CASE LAST COMMAND DIDN'T RESTORE IT
SETO A,
CAME A,NPAGE
CALL MAPPF ;DON'T LEAVE FORK PAGES MAPPED
SETZM CSZ1 ;ZERO STORAGE
MOVE A,[CSZ1,,CSZ1+1]
BLT A,CSZ2
;INITIALIZE WHAT NEEDS INITIALIZING
MOVE BFP,[POINT 7,CBUF,-1] ;BYTE POINTER INTO COMMAND BUFFER,
;IN WHICH ENTIRE LINE IS ACCUMULATED.
;STAYS IN BFP.
MOVE P,[IOWD PDL,PD] ;INIT PD POINTER
MOVE A,[IOWD JBUFL,JBUF] ;INIT PTR INTO JFN BUFFER
MOVEM A,JBUFP ;..
SETOM 1(A) ;INIT JFN BUFFER TO -1'S: 0 IS A JFN.
AOBJN A,.-1 ;..
MOVE A,[POINT 7,CSBUF,-1] ;INIT PTR INTO STR BUF FOR JSYS ARGS
MOVEM A,CSBUFP
MOVEI A,RERET ;REGULAR ERROR RETURN ADDRESS
MOVEM A,CERET ;SAY WHERE TO GO AFTER PRINTING ERR MSG
;CLEAR SOME FLAGS
SETZ Z, ;CLEARS PUNCTF, STCF, BAKFF, ETC.
SETZB KWV1,KWV ;NO SPECIAL BITS ON IN COMMAND KEYWORD
; TABLE VALUE. THIS IS IN CASE SOME
; SPECIAL SYNTAX
; NEVER SETS KWV1 BUT CALLS "CONF".
; THE ONLY SUCH CASES ARE
; <SUBSYSTEM NAME> AND INPUTTING
; DATE AND TIME. 6/30/70.
;CMDN5B
;REQUEST DATE AND TIME IF SYSTEM DOESN'T HAVE THEM.
;THIS MUST BE INSIDE COMMAND LOOP SO IT WILL BE REPEATED IF ERROR
; OR ↑C ABORTS FIRST ATTEMPT.
SKIPN AUTFLG ;DON'T IF AUTOJOB
SKIPE DTSF ;NON-0 IF HAVE DATE AND TIME
JRST CMDN5B ;...AND HAVE BEEN HERE BEFORE
GTAD ;FLAG NOT SET YET, GET DATE AND TIME
CAME A,[-1] ;-1 SAYS SYSTEM DATE & TIME NOT SET
JRST CMDN5B ;SYSTEM HAS DATE AND TIME.
;SYSTEM HAS NO DATE AND TIME, GET SAME. SUBR INDT (WITH ↑E SET IN
;X1CMD.MAC) INPUTS, CONFIRMS, AND SETS TIME & DATE. KWV1 MUST BE 0 NOW!
MOVE 1,CIJFN
SIBE ;INPUT ALREADY TYPED?
JRST [ TYPE < TAD= > ;YES, GIVE SHORT MESSAGE
JRST .+2]
TYPE < Enter date and time as MM/DD/YY HH:MM -- >
CALL INDT
CMDN5B: SETOM DTSF ;SAY SYSTEM HAS DATE AND TIME.
; THIS AVOIDS
; DOING GTAD EVERY TIME THRU LOOP.
;CMDN5D
;NOW THAT SYSTEM DEFINITELY HAS DATE & TIME, INITIALIZE "AUTOLOGOUT"
;STUFF IF NECESSARY.
SKIPN AUTFLG ;IF AUTO STARTUP JOB, OR ...
SKIPLE CUSRNO ; ALREADY LOGGED IN,
JRST CMDN5E ; NOT RELEVANT.
SKIPE ALOFH ;ALO FORK STARTED?
JRST CMDN5D ;YES, ALO INITIALIZATION ALREADY DONE.
GTAD ;SAVE STARTUP TIME FOR USE IN
MOVEM A,STRTIM ;"ALOTST" SUBR
;START UP FORK TO WATCH FOR ABANDONED JOB (NO TTY ACTIVITY FOR
;N SECONDS) AND PSI THIS FORK IF THAT OCCURS.
SETZ A,
CFORK ;FORK WHICH LOOKS FOR NO TTY ACTIVITY
CALL [ SETOM ALOFH ;ON ERROR THIS PREVENTS INFINITE
JRST JERR] ;...RETRY LOOP.
MOVEM A,ALOFH ;SAVE HANDLE FOR KILLING LATER.
HRLZI A,400000
HRLZ B,ALOFH
HRLZI C,B2+B3+B4
PMAP ;MAP PAGE 0 (STORAGE) INTO FORK
MOVEI A,ALOFRK
LSH A,-↑D9 ;GET PAGE # OF ALO ROUTINE
HRLI A,400000
MOVEI B,ALOFRK
LSH B,-↑D9 ;MUST SHIFT AT RUN TIME CAUSE RELOCATION
HRL B,ALOFH
PMAP ;MAP CODE PAGE INTO FORK
AOS A
AOS B
PMAP ;GIVE IT THE NEXT PAGE TOO. MAY CROSS
MOVE A,ALOFH
MOVEI B,ALOFRK
SFORK ;START ALO FORK
;JOB ISN'T LOGGED IN, SEE IF ITS TIME TO AUTO-LOGOUT IT.
CMDN5D: CALL ALOTST
;CMDN5E CMDN6 CMDN6A CMDN6B CMDN6C CMDN6D CMDN6E CMDN6J
CMDN5E: SKIPN AUTFLG ;AUTOSTARTUP JOB ?
JRST CMDN6 ;NO
SETOM ALOFH ;YES, DISABLE AUTO LOGOUT FORK
MOVE A,AUTFLG ;GET JFN OF PROG TO START
MOVEM A,CJFN1 ;AND SET FOR GET
SETZM AUTFLG ;CLEAR AUTOSTART FLAG
CALL RESET
CALL $GET2 ;DO THE GET AFTER CFORK IF NEEDED
MOVE A,FORK
MOVE B,APJFN
SPJFN
JRST ..STRT
;DO PERIODIC CHECK FOR NEW MAIL ARRIVAL
CMDN6: SKIPL MSGTIM ;IF "MAIL WATCH OFF"
SKIPG CUSRNO ;OR NOT LOGGED IN
JRST CMDN6D ;FORGET THE CHECK
TIME ;GET MILLISECOND TIME
CAMG A,MSGTIM ;PASSED DEADLINE FOR MAIL CHECK?
JRST CMDN6D ;NO
CMDN6A: MOVEI A,CMDN6C ;SET DISPATCH IN CASE CHKMSG BOMGS OUT
MOVEM A,CERET
MOVE A,CUSRNO ;OUR USER #
CALL CHKMSG ;SKIP IF USER IN A HAS NEW MAIL
JRST CMDN6C ;HE DOES NOT. JUST MAKE NEW DEADLINE.
CMDN6B: CALL CRIF
TYPE <[You have new mail]>
PRINT EOL
CMDN6C: TIME ;GET "NOW" AND TICKS/SECOND
MOVEI C,↑D<10*60> ;10 MINUTES OF SECONDS
IMULI C,0(B) ;CONVERT TO TICKS
ADDM C,A ;NEXT DEADLINE
MOVEM A,MSGTIM
MOVEI A,RERET ;RESTORE NORMAL ERROR DISPATCH
MOVEM A,CERET
CMDN6D:
;;DO PERIODIC CHECK OF PRINTER DIRECTORY
CMDN6E:; SKIPL PRNTIM ;IF "PRINTER WATCH OFF"
; SKIPG CUSRNO ;OR NOT LOGGED IN
; JRST CMDN6J ;FORGET THE PRINTER CHECK
; TIME ;GET MILLISECOND TIME
; CAMG A,PRNTIM ;PASSED DEADLINE FOR PRINTER CHECK?
; JRST CMDN6J ;NO
;
;CMDN6F: CALL CRIF ;ENSURE AT LEFT MARGIN
; MOVEI A,CMDN6H ;SET SPECIAL ERROR DISPATCH
; MOVEM A,CERET
; HRRZ A,CUSRNO ;OUR USER #
; CALL CHKPRN ;CHECK THE SPOOLER
; JRST [ UTYPE [ASCIZ /[Line printer output done]/]
; PRINT EOL
; SETOM PRNTIM ;CANCEL SUBSEQUENT CHECKING
; JRST CMDN6I]
;
;CMDN6G: TYPE <[Your listing has not finished]>
; PRINT EOL
;
;CMDN6H: TIME ;GET "NOW" AND TICKS/SECOND
; MOVEI C,↑D<60*5> ;5 MINUTES OF SECONDS
; IMULI C,0(B) ;CONVERT TO TICKS
; ADDM C,A ;NEXT DEADLINE
; MOVEM A,PRNTIM
;CMDN6I: MOVEI A,RERET ;RESTORE NORMAL ERROR DISPATCH
; MOVEM A,CERET
CMDN6J:
;CMDN6K
;DO PERIODIC CHECK FOR NEWLY-SCHEDULED DOWNTIME
SKIPL DWNMSF ;IF DOWNTIME ALREADY PRINTED
SKIPG CUSRNO ;OR NOT LOGGED IN
JRST CMDN6K ;FORGET THE DOWNTIME CHECK
TIME ;GET THE MILLISECOND TIME
CAMG A,DWNMSF ;TIME TO CHECK AGAIN YET?
JRST CMDN6K ;NO
CALL DWNTIM ;YES, CHECK FOR AND PRINT OUT DOWNTIME
TIME ;GET "NOW" AND TICKS/SECOND
MOVEI C,↑D<60*30> ;30 MINUTES OF SECONDS
IMULI C,0(B) ;CONVERT TO TICKS
ADDM C,A ;NEXT DEADLINE
SKIPL DWNMSF ;UNLESS CANCELLED DUE TO PRINTOUT
MOVEM A,DWNMSF
CMDN6K:
;CMDN7 CIN0A
;PRINT READY CHARACTER AND INPUT AND DECODE COMMAND
CMDN7: CALL READY ;PRINTS "@" OR "!" IF PRIV CMDS ENABLED
;BEGIN INPUTTING AND DECODING A COMMAND
;FIRST, INPUT FIRST FIELD. MUST INPUT WHOLE FIELD SO EDITING WORKS!
; DISTINGUISH 3 CASES:
; COMMAND BEGINS WITH A SPECIAL CHARACTER
; COMMAND BEGINS WITH A WORD
; COMMAND BEGINS WITH AN OCTAL NUMBER
TLO Z,NEOLF ;SAY DON'T ECHO EOL'S, BECAUSE THIS INPUT
;FIELD MAY BE A SUBSYSTEM NAME, AND GTJFN
;PRINTS AN EOL IF THERE IS AN EOL IN STRING,
;AND WE DON'T WANT TWO EOL'S PRINTED.
;THE FOLLOWING INPUTS A FIELD (IE TO A
;NON-ALPHANUMERIC CHARACTER), EDITS,
;AND IF INPUT WAS "?",
;TYPES GIVEN MESSAGE AND INPUTS AGAIN.
;"%Z" IN MESSAGE EXPANDS TO ALL
;KEYWORDS IN TABLE.
MOVEI A,CTBL1 ;COMMAND TABLE ADDRESS FOR %Z
INHELP <
Commands are:
%1Z
Subsystem name
Save file name
Number/
Number\ number
; Comment
>
CAIG CNT,1 ;IS FIELD COUNT (INCL. TERMINATOR) > 1?
JRST CIN1A ;NO, COMMAND BEGINS WITH SPECIAL CHAR
MOVE B,.BFP ;BYTE PTR TO BEGINNING OF FIELD
HRREI D,-1(CNT)
CIN0A: ILDB A,B ;GET CHARACTER OF FIELD
MOVE C,CHRTBL(A) ;GET INFO ABOUTSAID CHARACTER
TRNN C,OCTDIG ;TEST OCTAL DIGIT BIT
JRST CIN1C ;COMMAND MUST BEGIN WITH A WORD
SOJG D,CIN0A ;CHECK ALL CHARACTERS OF FIELD
JRST CIN6 ;COMMAND BEGINS WITH AN OCTAL NUMBER
;CIN1A CIN1C
;HANDLE CASES WHERE A NON-ALPHANUMERIC CHARACTER BEGINS COMMAND
CIN1A: TLZE Z,EOLNEF
PRINT EOL ;IF THE CHARACTER WAS EOL, NOW ECHO IT
CALL PASCOM ;IF LINE IS JUST A COMMENT, CHEW IT UP.
TRNE CBT,TEOL ;EOL, SEMICOLON, OR FORMFEED?
JRST CMDIN4 ;YES, NULL LINE, GO GET ANOTHER LINE.
CAIN TRM,CTRLE ;↑E PREFIXES PRIVILEGED COMMANDS
JRST [ SKIPN PRVENF ;ARE PRIV COMMANDS ENABLED?
JRST CERR ;NO
KEYWD CTBL2 ;SEARCH SPECIAL TABLE
0 ;NO DEFAULT
JRST CERR ;NOT FOUND
JRST CIN2] ;WIN
;OTHER SPECIAL CHARACTERS TO IMPLEMENT LATER ←←←←←←←←←←←
; \ = .\
; LF = .+1/
; ↑ = .-1/
; . = CURRENT LOCATION (\ OR / CAN FOLLOW)
CAIN TRM,"<" ;BEGIN DIR NAME FOR "RUN"?
JRST CIN3C ;YES.
;HAVEN'T RECOGNIZED IT YET.
;THIS SHOULD FALL THRU TO WORD CASE RATHER THAN ERROR OUT IF
; NULL IS TO BE DEFAULTED TO SOME COMMAND SUCH AS "HELP".
JRST CERR ;TYPE " ?" AND INPUT NEXT COMMAND.
;COMMAND BEGINS WITH A WORD.
;SEARCH COMMAND TABLE, THEN SUBSYSTEM DIRECTORY,
;THEN GO TO USER'S ERROR ROUTINE.
CIN1C: CAIE TRM,"." ;PERIOD TERMINATOR PRODUCES ERROR IN
CAIN TRM,"F"-100 ; "KEYWD", (CONTROL-F ALSO),
JRST CIN3 ;BUT IS MEANINGFUL IN SUBSYSTEM NAMES.
TLO Z,BAKFF+NEOLF ;SAY RE-USE THIS FIELD, DON'T ECHO EOL
KEYWD CTBL1 ;SEARCH TABLE OF REGULAR COMMANDS
0 ;T HELP,NOLOG+NOCONF+ONEWD
;COULD DEFAULT TO "HELP"
JRST [SKIPLE CUSRNO ;LOGGED IN?
JRST CIN3 ;NOT FOUND, GO LOOK FOR SUBSYSTEM NAME.
JRST .LOGIN]
;FOUND, FALL INTO CIN2.
;CIN2 CIN2B
;HAVE VALID FIRST KEYWORD IN COMMAND
;OR HAVE DECODED A SPECIAL SYNTAX SUCH AS "<OCTAL #>/".
;VALUE WORD FROM TABLE IS IN AC "KWV".
;MAKE PRE-DISPATCH CHECKS
CIN2: TLZE Z,EOLNEF
PRINT EOL ;IF IT ENDED IN UNECHOED CR, NOW ECHO IT
;ABOVE IS NEEDED DESPITE THE FACT
;THAT "CONF" DOES IT FOR
;MULTILINE COMMANDS SUCH AS "LOGIN"
MOVE KWV1,KWV ;1ST KW'S VALUE WD STAYS IN KWV1.
TLNE KWV1,NOLOG
JRST .+3
SKIPG CUSRNO ;SKIP IF LOGGED IN
ERROR <Login please>
TLNE KWV1,EASUB ;DOES CMND EXAMINE, ALTER, OR RUN PROG?
JRST [ SKIPN PRVENF ;YES, PRIVILEGES ENABLED?
SKIPN PROPSF ;NO, PROPRIETARY PROGRAM?
JRST .+1 ;OK
JRST CERR] ;UNAUTHORIZED MEDDLING
TLNE KWV1,ONEWD ;IS IT A ONE-WORD COMMAND?
CONFIRM ;YES, HANDLE CONFIRMATION NOW.
;DISPATCH TO ROUTINE TO DECODE REST OF (NON-ONE-WORD) COMMAND THEN
;EXECUTE COMMAND.
;IF "INFILN" BIT WAS ON, JFN IS STILL IN A, AS WELL AS "CJFN1".
CIN2B: CALL (KWV1) ;DISPATCH WITH PUSHJ,
;CAN RETURN WITH POPJ
;OR JRST CMDIN2,3,4.
JRST CMDIN4 ;WHERE MOST COMMANDS SHOULD RETURN.
;CIN3 CIN3C CIN3B CIN3A
;FIRST KEYWORD IS NOT A COMMAND NAME,
; SEE IF ITS A SUBSYSTEM NAME
;ALSO GET HERE ON OCTAL NUMBER NOT FOLLOWED BY /, \, ETC.
CIN3: TLOA Z,BAKFF+NEOLF+F3 ;SAY REUSE FIELD, DON'T ECHO EOL
;F3 SAYS TO TRY CONN AND LOGIN
; AFTER SUBSYS
;DIRECTORY SPECIFIED (OPEN ANGLE BRKT. SEEN). SEARCH ONLY IT.
CIN3C: TLO Z,BAKFF+NEOLF
MOVE A,[B0,,400000]
MOVE B,PTTYMD+6 ;INTERRUPT MASK
MOVE C,PTTYMD+7 ;DEFERRED INTERRUPTS
STIW ;SET THEM
;ERROR WILL UNSET THEM IN UNKNOWN NAME
MOVEI A,[ASCIZ /SUBSYS/] ;DEFAULT DIRECTORY NAME
CALL CPFN ;COLLECT PROGRAM FILE NAME
JRST CIN5 ;NOT A SUBSYSTEM NAME
JRST CIN3B
JRST CIN3A
CIN3B: SKIPG CUSRNO ;SKIP IF LOGGED IN
ERROR <Login please>
CIN3A: ;NOTE: KWV1 WAS SET TO 0 ABOVE. 0 IS OK HERE.
MOVE A,CJFN1 ;FILE TO "RUN"
MOVE B,[1,,FDBCTL] ;CONTROL WORD
MOVEI C,C ;TO C
CALL $GTFDB ;GTFDB OR DON'T SKIP
JRST CERR ;DOESN'T EXIST FOR THIS USER
CAIE TRM,33 ;MUST CONFIRM IF ALTMODE USED
TLO KWV1,PROGX ;SAY WE'RE PASSING CONTROL TO PROGRAM
TLNE C,(FDBEPH) ;IS THE FILE AN EPHEMERON?
JRST CIN4 ;YES, TO HANDLE AS SUCH
PUSH P,[..STRT] ;SET RETURN TO JOIN "START" COMMAND
JRST GET1 ;AND JOIN "GET" COMMAND
;CIN4 CIN4A CIN40 CIN41 CIN42 CIN43 CIN44 CIN45
;RUN AN EPHEMERAL SUBSYSTEM
; THIS IS TO BEHAVE AS AN EXTENTION TO THE EXEC, THEREFORE:
; IT RUNS WITH THE EXEC'S TTY MODES IN EFFECT, AND
; IF THE TERMINATOR WAS SOMETHING THAT CAN BE INTERPRETED
; AS THE BEGINNING OF A FILE NAME, THE INPUT FILE WILL BE
; BACKED SO THAT THE EPHEMERON CAN GOBBLE IT.
; EFORK IS -1 OR FORK HANDLE IN WHICH THE EPHEMERON IS RUNNING.
; THIS IS CHECKED IN ↑C AND ERROR ROUTINES FOR APPROPRIATE ACTION.
; NOTE THAT THESE CONDITIONS ARE HANDLED EXACTLY THE SAME AS
; IF THEY HAD OCCURRED DURING AN EXEC COMMAND.
CIN4: NOISE <;E>
CIN4A: CONFIRM
SETZ B, ;USE ENTRY VECTOR INDEX 0
;ENTER HERE FROM PLACES LIKE "ARCHIVE DELETE ..."
CIN40: PUSH P,B ;EV INDEX IN B
CONFIRM
SETOM 1
CALL MAPPF ;FLUSH ANY MAPPED PAGE
CIN41: INTOFF
MOVEI 1,-1 ;NO CAPS., NONSENSE PC
CFORK
JRST [ INTON
UERR [ASCIZ /No forks available -- try again/]]
MOVEM 1,EFORK ;SAY WE HAVE AN EPHEMERAL FORK
MOVE 2,[777000,,777777] ;CAPABILITIES TO TRANSMIT
SKIPE 3,PRVENF ;IF ENABLED IN THIS EXEC,
MOVE 3,2 ;ENABLE THE EPHEMERON
EPCAP
CIN42: PUSH P,SUBSYS ;SAVE OLD SUBSYS NAME
MOVE B,CJFN1 ;FILE TO RUN
CALL SUBNAM ;SETUP LOCATION SUBSYS
MOVE 1,SUBSYS
SETNM
POP P,SUBSYS ;FOR WHEN WE RUN NORMAL FORK AGAIN
CIN43: INTON
MOVEI 1,GETILI ;SET SPECIAL ILLEGAL INSTR DISPATCH
MOVEM 1,ILIDSP ;IN CASE GET ITRAPS
HRR 1,CJFN1
HRL 1,EFORK
GET
SETZM ILIDSP ;NO LONGER INTERESTED IN ILL INSTRS
CALL RLJFNS ;FLUSH ANY JFNS THAT ARE HANGING AROUND
CIN44: MOVE 1,EFORK
GEVEC
HLRE 3,2
JUMPE 3,.+4
CAIL 3,1000
CAIN 3,(JRST)
CAIA
ERROR <Not runnable>
POP P,3 ;GET EV INDEX
ADD 2,3 ;COMPUTE START LOCATION
TLZ 2,-1
SFORK
CIN45: WFORK ;↑C AND ERRORS HAPPEN HERE
INTOFF
MOVE 1,EFORK
FFORK
MOVE 2,[CALL CUUO]
MOVEM 2,41 ;REALLY NEEDED?
RFSTS ;FIND OUT WHY IT TERMINATED
TLZ 1,(1B0) ;FLUSH FROZEN BIT
CAMN 1,[2,,0] ;VOLUNTARY TERMINATION
JRST [ MOVE 1,EFORK
KFORK
SETOM EFORK
INTON
JRST CMDIN2] ;RETURN TO COMMAND INPUT
TLNE 1,077700 ;LOOK FOR -1 INSTEAD OF FORK HANDLE
JRST [ SETOM EFORK ;SAY IT HAS GONE
INTON
UERR [ASCIZ /Ephemeron killed itself/]];WIERD
PUSH P,A
INTON
POP P,A
PRINT EOL
TYPE < During ephemeron:>
JRST INVOLT ;AFTER "WAIT" IN X1CMD
;CIN5
;NOT A SUBSYSTEM NAME,
; GO TO SPECIAL ERROR PROCESSOR IF THIS USER HAS ONE
;4/30/70: AT THIS POINT WE DON'T KNOW THE WHOLE INPUT TEXT
; BECAUSE WE HAVEN'T CAPTURED CHARACTERS READ BY GTJFN.
CIN5: ;BRANCH TO PROCESSOR IF ANY
;(NOT IMPLEMENTED YET)
JRST CERR ;STANDARD ERROR PROCESSING, "?" TEXT.
;CIN6
;COMMAND BEGINS WITH OCTAL NUMBER
CIN6: CAIE TRM,"." ;IF IT ENDS WITH ".", OR
TRNE CBT,TEOL+TSPC+TALT ;IF IT ENDS WITH EOL, SPACE, OR ALTMODE,
JRST CIN3 ;TAKE AS A SUBSYSTEM NAME.
;DECODE SPECIAL SYNTAXES FOR / AND \ COMMANDS.
TLO Z,BAKFF ;UN-INPUT THIS FIELD
CALL OCTAL ;INPUT 18-BIT OCTAL NUMBER
CALL SCREWUP ;NULL INPUT CAN'T OCCUR
PUSH P,A ;SAVE VALUE OBTAINED
;THE TERMINATOR OF THE OCTAL NUMBER IDENTIFIES THE COMMAND.
;GET A DUMMY "TABLE VALUE WORD" APPROPRIATE FOR THE COMMAND AND
; GO THROUGH THE REGULAR CHECK AND DISPATCH CODE TO CHECK FOR
; NOT LOGGED IN, PROPRIETARY PROGRAM, ETC.
MOVE KWV,[EASUB,,CSLSH]
CAIN TRM,"/"
JRST CIN2
MOVE KWV,[EASUB+ALTCON,,CBKSL]
CAIN TRM,"\"
JRST CIN2
JRST CERR
;NOTE: "CIN2" DISPATCHES WITH PUSHJ, SO WHEN COMMAND ROUTINE IS
;ENTERED, THE VALUE SAVED ABOVE IS AT -1(P), NOT 0(P).
;CSLSH
;EXECUTE "/" COMMAND (EXAMINE)
;DECODING AND CHECKS ARE COMPLETE, CONFIRMATION ISN'T USED.
CSLSH: MOVE A,-1(P) ;ADDRESS
CALL MAPPF ;MAP THAT PAGE & GET ACCESS INFO
TLNN A,B5
ERROR <No such page>
TLNN A,B2
ERROR <Can't read that page>
MOVE A,-1(P) ;GET ADDRESS AGAIN
MOVEM A,DOT ;UPDATE CURRENT LOCATION
ANDI A,777 ;GET REL ADDRESS IN PAGE
PRINT TAB ;OUTPUT A TAB
HLRZ B,PAGEN(A) ;LH OF WORD IN PAGE BUFFER
JUMPE B,.+3 ;LH NON-0?
CALL TOCT ;YES, TYPE IT IN OCTAL
TYPE <,,>
HRRZ B,PAGEN(A) ;RH
CALL TOCT ;TYPE IT
PRINT EOL ;TYPE CARRIAGE RETURN
JRST CMDIN4 ;DONE, GET NEXT COMMAND
;CBKSL CBKSL1 CBKSL5
;FINISH DECODING AND EXECUTE "\" COMMAND (DEPOSIT)
;SYNTAX IS <ADDR>\<VALUE>
; OR <ADDR>\<LH><SPACE, TAB, ALT MODE, COMMA, OR 2 COMMAS><RH>
CBKSL: SKIPL FORK ;FORK EXISTS?
JRST CBKSL1 ;YES
CALL ECFORK ;NO, CREATE ONE
CBKSL1: MOVE A,-1(P) ;NOTE: COMMAND RETURN ADDRESS IS AT 0(P)
CALL MAPPF ;MAP THAT PAGE AND GET ACCESS INFO
MOVEM A,-1(P) ;SAVE ACCESS INFO WITH ADDRESS
TLNN A,B5
JRST [ UTYPE [ASCIZ / [New] /] ;ADVISORY MESSAGE
JRST .+3] ;DON'T TEST WRITE BIT HERE!
TLNN A,B3
JRST [ TLNN A,B9 ;COPY-ON-WRITE BIT
UERR [ASCIZ /Can't write that page/]
UTYPE [ASCIZ / [Shared] /]
JRST .+1]
;GET VALUE
CALL OCTCOM ;INPUT VALUE, ACCEPTING LH,,RH ETC,
JRST CERR ;R1: NULL. ...AND CHECKS TERMINATOR.
CONFIRM
MOVE B,-1(P)
HRRZM B,DOT ;UPDATE CURRENT LOCATION
;STORE A AT B IN FORK. ASSUME WE STILL HAVE THE PAGE.
CBKSL5: ANDI B,777 ;MASK OFF PAGE # PART OF ADDRESS
MOVEM A,PAGEN(B) ;STORE INTO PAGE BUFFER
;EXECUTION OF "\"...
;IF ADDRESS < 20, SET FORK AC'S. NON-AC PAGES HANDLE THEMSELVES.
MOVE C,DOT
CAILE C,17
JRST CMDIN4
MOVE A,FORK
MOVEI B,PAGEN
CAIGE C,20
SFACS
JRST CMDIN4
;ALOTST ALOFRK ALF1 ALF2 ALF3
;SUBROUTINE TO "AUTOLOGOUT" THIS JOB IF NOT LOGGED IN AND MORE
; THAN "AUTOL1" SECONDS HAVE ELAPSED SINCE STARTUP.
;ONE CALL IN CMDIN4 AREA.
ALOTST: PUSH P,A
GTAD
SUB A,STRTIM
SUBI A,AUTOL1
JUMPG A,AUTOLO ;DO AUTOLOGOUT (XSUBRS.MAC)
POP P,A
RET
;ROUTINE FOR FORK TO AUTO-LOGOUT ABANDONED JOBS.
;IF NO TTY ACTIVITY FOR N SECONDS, LOGOUT, ELSE REPEAT, UNTIL LOGGED IN.
;THIS FORK IS KILLED IN "LOGIN" CODE AND "ERRET" CODE
; IN MAIN FORK.
ALOFRK: MOVEI A,AUTOL2*↑D1000 ;NUMBER OF SECONDS TO WAIT BEFORE
DISMS ;...DOING ANYTHING HERE
;LOOP TO LOOK FOR INACTIVE TTY
ALF1:
ALF2: MOVE C,TTYACF ;AOS'D FOR EVERY CHAR IN/OUT
MOVEI A,AUTOL3*↑D1000 ;NUMBER OF SECS DURING WHICH THERE
DISMS ;... MUST BE NO ACTIVITY
CAME C,TTYACF ;HAVE ANY CHARS BEEN TRANSFERRED?
JRST ALF1 ;YES, WAIT AND CHECK AGAIN
ALF3: SETZM STRTIM ;CAUSES AUTOLOGOUT AT COMMAND INPUT IF
;AN ERROR OR ↑C PREVENTS IT FROM
;COMPLETING AFTER PSI.
MOVEI A,-1 ;MAIN EXEC FORK,
HRLZI B,B2 ;CHANNEL 2
IIC ;GOOSE TO SAY AUTOLOGOUT NEEDED
HALTF
;READ ONLY STORAGE AREA
;COMMAND TABLES
;FORM:
; LABEL: NUMBER OF ENTRIES
; [VALUE],,[ASCIZ @TEXT@] FOR EACH ENTRY, ALPH ORDER
; VALUE IS GENERALLY BITS,,ADDRESS
; SEE "DEFINITIONS" FILE FOR BIT SYMBOLS AND MACRO DEFINITIONS
;MACROS USED TO GENERATE TABLES (DEFINED IN "DEFINITIONS" FILE)
;
; T TEXT[,BITS[,ADDRESS]] ;HERE []'S MEAN OPTIONAL
; SETS UP ENTRY. DEFAULTS ADDRESS TO ".TEXT", OR IF
; THAT IS UNDEFINED, TO "NOT IMPLEMENTED" ERROR ROUTINE
;
; X TEXT
; CREATES A SPECIAL FAKE ENTRY, TO MAKE AN OTHERWISE
; UNIQUE SUBSET AMBIGUOUS (EVEN THE EXACT TEXT GIVEN TO X
; MACRO WILL BE TREATED AS AMBIGUOUS). USED WHERE ACTUAL
; AMBIGUITY IS WITH AN ENTRY IN ANOTHER TABLE SEARCHED
; LATER.
;
; TABLE RESERVES WD FOR # ENTRIES AT TOP OF TABLE
;
; TEND FILLS IN # OF ENTRIES SINCE LAST "TABLE" MACRO
; IN LOCATION RESERVED BY THAT "TABLE" MACRO
;CTBL1
;COMMANDS NOT PREFIXED BY ↑E.
;ALL BUT THOSE WITH "WOEPUO" BIT ARE AVAILABLE TO ANY USER.
CTBL1: TABLE
T ACCESS,LPROK!LANOK ;ACCESS (OF FILES)--(TO)--(IS)--
; T ACCOUNT,LPROK ;ACCOUNT (OF FILE)--(IS)--
; T ADVISE,LPROK+EOLOK+ALTCON ;ADVISE (USER)
T APPEND,LANOK+CONMAN+LPROK ;APPEND <FILE> (TO) <FILE>
; T ARCHIVE ;ARCHIVE
T ASSIGN,LPROK ;ASSIGN <DEVICE> (AS) <NAME>
T ATTACH,NOLOG+LPROK+ALTCON ;ATTACH (TO JOB) <JOBNO>
T AVAILABLE,EOLOK+NOLOG+NOCONF ;AVAILABLE LINES/DEV
; T BDDT,ONEWD+ALTCON+EASUB ;START BDDT
T BREAK,NOLOG+EOLOK+LPROK+ALTCON ;BREAK (LINKS)
T BYE,NOLOG+EOLOK+LPROK+ALTCON,.BREAK ;BREAK (LINKS)
T CHANGE,LPROK+ALTCON ;CHANGE PASSWORD OR ACCOUNT
T CLEAR,LPROK+CONMAN ;CLEAR DEVICE DIRECTORY
T CLOSE,LANOK+LPROK ;CLOSE (FILE) <NAME>
T COMMANDS,LPROK ;COMMANDS (FROM FILE) <FILE>
T CON,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /TINUE /] ;CON=CONTINUE
JRST .CONTI]> ;...DESPITE CONNECT
T CONNECT,LPROK ;CONNECT (TO DIRECTORY) <NAME>
T CONTINUE,EOLOK ;CONTINUE
T COPY,LANOK+CONMAN+LPROK ;COPY <FILE> (TO) <FILE>
T DAYTIME,ONEWD+NOLOG+NOCONF ;DAYTIME
T DDT,ONEWD+ALTCON+EASUB ;START DDT
T DEASSIGN,LPROK ;DEASSIGN <LDEV/DEVICE>
; T DEFINE,LANOK+LPROK+INVIS ;DEFINE (NEW FILE)--(AS)--
T DELETE,LANOK ;DELETE <FILE>
T DETACH,EOLOK+LPROK+LANOK+ALTCON ;DETACH JOB
T DI,INVIS+NSPALT+COMOK+EOLOK,<[UALTYP [ASCIZ /RECTORY /]
JRST .DIREC]>
T DIRECTORY,COMOK+EOLOK+LANOK+ALTCON ;DIRECTORY.
T DIS,NSPALT+EOLOK+INVIS+WOEPUO,<[UALTYP [ASCIZ /ABLE /]
JRST .DISAB]> ;DIS=DISABLE, NOT AMBIG.
T DISABLE,WOEPUO+ONEWD+ALTCON+INVIS ;DISABLE PRIV CMNDS
T DISCUSE,ONEWD+NOCONF+NOLOG ;AMOUNT OF DISC AVAILABLE
T DSKSTAT,ONEWD+NOCONF ;DISK STATUS
; T DUMP,LANOK+CONMAN+LPROK+INVIS ;DUMP (ON) <FILE>
T EDIT,LANOK+EOLOK+ALTCON ;EDIT <FILE>
T ENABLE,WOEPUO+ERRUO+ONEWD+INVIS ;ENABLE PRIV CMDS
T ENTRY,LPROK ;SET ENTRY VECTOR
T EPHEMERAL,LANOK ;MARK AS AN EPHEMERON
T ERRSTAT,ONEWD+NOCONF ;ERROR STATUS
T ERUN,LANOK+LPROK ;RUN PROGRAM AS AN EPHEMERON
T EXEC,EOLOK+ONEWD ;EXEC (RUN SEPARATELY FROM FORK)
T EXPUNGE,LPROK+EOLOK ;EXPUNGE (DELETED FILES)
T F,INVIS+NSPALT+NOLOG+EOLOK,<[UALTYP [ASCIZ/INGER /]
JRST .FINGE]> ;F=FINGER
T FILSTAT,NOCONF+ONEWD ;FILE STATUS
T FINGER,NOLOG+EOLOK+ALTCON ;FINGER
T FORK; ;FORK <N>. AFFECTS /, \, ETC.
T FORMFEED,NOLOG+ALTCON+ONEWD ;SAYS TTY HAS FORMFEED
; X FU ;REQUIRE 3 CHARS FOR FULLDUPLEX
T FULLDUPLEX,NOLOG+ONEWD+ALTCON ;SAYS TTY IS FULL DUPLEX
T GET,LANOK+LPROK ;GET <FILE>
T GOTO,EASUB+LPROK ;GOTO <OCTAL>
; T HAL,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /FDUPLEX /]
; JRST .HALFD]> ;AVOID HALT
T HALFDUPLEX,NOLOG+ONEWD+ALTCON
; T HALT,INVIS+EOLOK+COMOK ;HALT THE SYSTEM
T IDDT,ONEWD+ALTCON+EASUB ;START AN IDDT
T IMPSTAT,NOLOG+NOCONF+ONEWD ;TYPE STATUS OF IMP
T INDICATE,NOLOG+EOLOK+LPROK ;INDICATE (FORMFEED)
; T INTERROGATE,LPROK+EOLOK+LANOK+ALTCON ;CHECK ARCHIVE
T JFNCLOSE,LPROK ;JFNCLOSE <JFN>
T JOBSTAT,ONEWD+NOCONF ;JOB STATUS
T K,INVIS+EOLOK+NOLOG,.LOGOU ;LOGOUT (DON'T CONFLICT WITH KK)
T KJOB,EOLOK+NOLOG,.LOGOU ;LOGOUT
T KKJOB,EOLOK+NOLOG ;VERY FAST LOGOUT
T LENGTH,NOLOG+LPROK,.LLENG ;LENGTH (OF PAGE IS)
; T LIMIT,LPROK+ALTCON+INVIS ;LIMIT (ADDITIONAL)--(TO)--
T LINK,NOLOG+LPROK ;LINK (TO)
; X LIS ;BECAUSE OF "LISP"
T LIST,LANOK+ALTCON ;LIST <FILE>. TAKES SUBCOMMANDS.
T LOG,NOLOG+NSPALT+EOLOK+LPROK+INVIS+ALTCON,<[SKIPG CUSRNO
JRST [UALTYP[ASCIZ/IN /]
JRST .LOGIN] ;FUDGE TO RECOG "LOG" AS "LOGIN"
UALTYP [ASCIZ /OUT /]
JRST .LOGOU]>
T LOGIN,NOLOG+EOLOK+LPROK+ALTCON ;LOGIN <USER> <PASSWD> <ACCT>
T LOGOUT,EOLOK+NOLOG ;LOGOUT
T LOWERCASE,NOLOG+ONEWD+ALTCON ;SAYS TTY HAS LOWER CASE
T MAIL,NOLOG
T MEMSTAT,ONEWD+NOCONF+EASUB ;MEMORY STATUS
T MERGE,LANOK+EASUB ;MERGE <FILE>
T MOUNT ;MOUNT <DEVICE>
X N
IFN DST10X,< T NETLOAD,ONEWD+NOCONF+NOLOG ;PRINT NETWORK LOAD AVS>
T NO,NOLOG+ALTCON ;NO TABS/FORMFEED/LOWERCASE
T NOT,ALTCON ;NOT EPHEMERAL
T NUMBER,LPROK!NOCONF ;NUMBER (OF DIRECTORY) <NAME>
; T PERPETUAL,LPROK+LANOK+ALTCON ;"PERPETUAL <FILE>"
T PISTAT,ONEWD+NOCONF ;PISTAT
T PRINT,LANOK+CONMAN+LPROK ;PRINT <FILE GROUP> (ON LPT:)
; T PRINTER,,.PRNTR ;"PRINTER CHECK/WATCH"
T PROTECTION,LPROK ;PROTECTION (OF FILE)--(IS)--
T QD,COMOK+EOLOK+LANOK+ALTCON ;HPP'S HACK
T QFD,COMOK+EOLOK+LANOK+ALTCON ;QUICK FILE DESCRIPTION
T QR,COMOK+EOLOK+LANOK+ALTCON ;HPP'S HACK
T QSYSTAT,ONEWD+NOCONF+NOLOG ;QUICK SYSTAT HACK FOR MGM
T QUIT,EOLOK+ONEWD ;QUIT: EXIT TO SUPERIOR EXEC
T QW,COMOK+EOLOK+LANOK+ALTCON ;HPP'S HACK
T RAISE,NOLOG+ONEWD+ALTCON ;RAISE L.C. INPUT TO UPPER CASE
T RECEIVE,EOLOK+LPROK+ALTCON ;RECEIVE (LINKS OR ADVICE)
T REDIRECT,EOLOK+LPROK+LANOK ;REDIRECT PRIMARY I/O
T REENTER,EOLOK ;REENTER
T REFUSE,EOLOK+LPROK+ALTCON ;REFUSE (LINKS OR ADVICE)
T RENAME,LPROK+LANOK+CONMAN ;RENAME (...) -- (TO BE) --
T RESET,EOLOK+ONEWD ;RELEASES MEMORY & CLOSES FILES
T REWIND,LPROK+LANOK ;REWIND <DEVICE>
T RUN,LANOK+LPROK ;RUN <FILE>. STARTS ENV FILE.
T RUNSTAT,ONEWD+NOCONF ;RUN STATUS: IO WAIT, ETC.
; X SA ;"SAIL" MIGHT BE A SUBSYS
T SAVE,CONMAN+LPROK+LANOK+EASUB ;SAVE ... (ON) <FILE>.
T SHOW,NOLOG+EOLOK+LPROK ;SHOW (LOWER CASE WITH %)
T SHUT,LPROK+EOLOK ;SHUT (ALL OPEN FILES)
T SINK,NOLOG+EOLOK+ALTCON ;SINK
T SSAVE,CONMAN+LPROK+LANOK+EASUB ;SHARABLE SAVE
T ST,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /ART /]
JRST .START]> ;ST=START DESPITE STAT
T STA,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /RT /];STA=START
JRST .START]>
T START,EOLOK ;START PROGRAM
T STAT,NSPALT+EOLOK+NOCONF+INVIS,<[UALTYP [ASCIZ /ISTICS /]
JRST .STATI]> ;"STAT" = "STATISTICS"
T STATISTICS,EOLOK+NOCONF ;SYSTEM STATISTICS
T STATUS,ONEWD+NOCONF+INVIS ;SEE SYSTAT, JOBSTAT, ETC.
T STOPS,ALTCON ;SET SOFTWARE TAB STOPS
T SYSTAT,ONEWD+NOCONF+NOLOG ;SYSTEM STATUS PRINTOUT
; X TA ;REQUIRE 3 CHARACTERS FOR "TABS"
T TABS,NOLOG+ONEWD+ALTCON ;SAYS TTY HAS HDWE TABS
T TERMINAL,NOLOG+LPROK ;TERMINAL TYPE IS N
T TRMSTAT,ONEWD+NOCONF ;TERMINAL STATUS TYPEOUT
T TTYPE,LANOK+CONMAN+LPROK ;COPY TO TTY:
T TYPE,LPROK+LANOK+ALTCON ;LIST FILE TO TTY
T UNDELETE,LPROK+LANOK ;UNDELETE <FILE>
T UNLOAD,LPROK+LANOK ;UNLOAD <DEVICE>
T UNMOUNT,LANOK ;UNMOUNT <DEVICE>
T USESTAT,ONEWD+NOCONF ;TYPES TIME USED, ETC.
T VERSION,ONEWD+NOCONF ;IN XMAIN.MAC
T WHERE,LPROK+NOLOG+NOCONF ;WHERE (IS USER) <NAME>
T WIDTH,NOLOG+LPROK,.LWIDTH ;WIDTH (OF LINE IS)
TEND
REPEAT 5,<0> ;ROOM TO BLT TABLE DOWN FOR PATCHING
;CTBL2
;PRIVILEGED COMMANDS PREFIXED WITH ↑E
;ONLY LEGAL FOR PRIV USERS WHO HAVE "ENABLE"D PRIV COMMANDS
CTBL2: TABLE
; T ACCOUNT,ONEWD+WHLUO+OPRUO,..ACCO ;TURNS ON ACCOUNTING
; T ASSIGN,WHLUO+OPRUO,..ASSI ;↑EASSIGN <DEVICE>
; T BROADCAST,ONEWD+WHLUO+OPRUO ;SEND MSG TO ALL TERMINALS
T CREATE,LPROK+OPRUO+WHLUO ;CREATE/MODIFY DIRECTORY
T CYCLE,LPROK+OPRUO+WHLUO ;CYCLE THE NETWORK
T DISK,LPROK+OPRUO+WHLUO,...DSK ;SET PANIC LEVELS
T EDDT,ONEWD+WHLUO ;GO TO DDT LOOKING AT EXEC
T HALT,EOLOK+COMOK ;HALT THE SYSTEM /HGM TYPES THE ↑E
; T INITIALIZE,WHLUO+OPRUO ;INITIALIZE SOMETHING
; T K,LPROK+WHLUO,.KFACT ;K (FACTOR) IS ...
T LOAD,LPROK+WHLUO+OPRUO ;LOAD (EDDT)
T NETWORK,WHLUO+OPRUO+LPROK+CONMAN ;TURN OFF/ON NETWORK
; T NOACCOUNT,ONEWD+WHLUO ;TURNS OFF SYSTEM ACCOUNTING
T OFFLINE,LPROK+WHLUO+OPRUO ;REMOVE CORE PAGES
T ONLINE,LPROK+WHLUO+OPRUO ;ADD CORE PAGES
T PAUSE,LPROK+WHLUO+OPRUO,..PAUS ;DCHKSW CONTROL
T PERMIT,LPROK+WHLUO+OPRUO ;PERMIT LOGINS
T PRINT,LPROK+WHLUO+OPRUO,..PRIN ;PRINT DIRECTORY INFORMATION
T PROCEED,LPROK+WHLUO+OPRUO ;PROCEED AT BUGCHK
T PROHIBIT,LPROK+WHLUO+OPRUO ;PROHIBIT LOGINS
T SET,LPROK+WHLUO+OPRUO+CONMAN ;SET DATE AND TIME
T SYSTEM,LPROK+WHLUO+OPRUO ;DEBUGSW CONTROL
; T TRAPS,LPROK+WHLUO+OPRUO ;JSYS TRAPS ON/OFF
T UNLOAD,LPROK+WHLUO+OPRUO,..UNLOA ;UNLOAD (EDDT)
; T UNHANG,WHLUO+OPRUO ;↑E UNHANG <DEVICE>
TEND
;CHRTBL
;CHARACTER TABLE
;ONE WORD PER CHARACTER:
; DESCRIPTIVE BITS IN RIGHT HALF
; LH: SPECIAL CASE DISPATCH FOR SUBROUTINE "CCHRI" (XSUBRS.MAC).
;WORD FROM "CHRTBL" FOR LAST CHARACTER IS GENERALLY IN THE AC "CBT".
;BITS IN RIGHT HALF (VALUES DEFINED IN FILE "D")
; ALPHAN ALPHANUMERIC CHARACTERS, - # '
; OCTIG 0-7
; PUNBIT MOST OTHERS EXCEPT FILE NAME FIELD TERMINATORS
; TEOL EOL, SEMICOLON, FORMFEED
; TSPC SPACE, TAB
; TALT ALT MODE
; TCOM COMMA
; TLPR LEFT PAREN
; TRPR RIGHT PAREN
; TCOL COLON
; TLAN LEFT ANGLE BRACKET
; TRAN RIGHT ANGLE BRACKET
CHRTBL: 0 ;NULL
$CTRLA,,0 ;↑A DELETE CHARACTER
0 ;↑B
0 ;↑C
0 ;↑D
0 ;↑E
0 ;↑F "RECOGNIZE FIELD" FOR FILE NAMES
0 ;↑G
$CTRLH,,0 ;↑H - BACKSPACE - MAKE IT DELETE A CHAR
TSPC ;↑I = TAB. TREATED LIKE SPACE.
0 ;↑J = LINE FEED
0 ;↑K
$FORMF,,TEOL ;↑L FORM FEED
0 ;↑M = CR. CR-LF BECOMES EOL B4 CHRTBL REFERENCE
0 ;↑N
0 ;↑O
0 ;↑P
0 ;↑Q
$CTRLR,,0 ;↑R RETYPE LINE
0 ;↑S
0 ;↑T PRINT RUNTIME PSI CHARACTER
0 ;↑U
$CTRLV,,0 ;↑V QUOTE NEXT CHARACTER
$CTRLW,,0 ;↑W DELETE FIELD
$CTRLX,,0 ;↑X DELETE WHOLE COMMAND
0 ;↑Y
0 ;↑Z MEANS EOF FROM TTY TO COPY CMD
TALT ;33: ALT MODE
0
0
0
$EOL,,TEOL ;37: EOL (REPRESENTS CR-LF)
TSPC ;40: SPACE
PUNBIT ;!
PUNBIT ;"
ALPHAN ;# "ALPHANUMERIC" FOR NOISE WDS, EG "JOB #"
PUNBIT ;$
PUNBIT ;%
$CONT,,PUNBIT ;&: CONTINUE ON NEXT LINE, TREATED AS SPACE
ALPHAN ;'
TLPR ;(
PUNBIT+TRPR ;)
PUNBIT ;*
PUNBIT ;+
TCOM ;,
$DASH,,ALPHAN ;- "ALPHANUMERIC" BECAUSE ITS FIELD-NULLER
0 ;.
PUNBIT ;/
REPEAT 10,<ALPHAN+OCTDIG ;0 THRU 7
>
ALPHAN ;8
ALPHAN ;9
TCOL ; : ACCEPTABLE TERMINATOR FOR DEVICE NAMES
PUNBIT+TEOL ;SEMICOLON: TREAT AS EOL WHEN USED AS TERMINATOR
TLAN ;<
PUNBIT ;=
TRAN ;>
PUNBIT ;?
PUNBIT ;100: @
REPEAT ↑D26,<ALPHAN ;A THRU Z = 101 THRU 132
>
PUNBIT ;[
PUNBIT ;\
PUNBIT ;]
PUNBIT ;↑
PUNBIT ;←
0 ;140=WHAT?
REPEAT ↑D26,<ALPHAN ;LOWER CASE A-Z = 141-172
>
0
0
0
0
$RUB,,0 ;177: RUBOUT
IFN .-CHRTBL-200,<PRINTX CHARACTER TABLE SCREWED UP
>
;LEVTAB CHNTAB
;PSEUDO-INTERRUPT SYSTEM TABLES
;LEVEL TABLE: WHERE TO STORE PC'S FOR VARIOUS LEVELS
LEVTAB: LEV1PC
LEV2PC
LEV3PC
;CHANNEL TABLE
;INDEXED BY CHANNEL NUMBER. LEVEL,,ADDRESS FOR EACH.
CHNTAB:
0 ;0: USED BY MINI-EXEC?
1,,CCPSI ;1: ASSIGNED BY PROGRAM TO ↑C
1,,ALOPSI ;2: ASSIGNED BY PROGRAM TO AUTO-LOGOUT
2,,USEPSI ;3: ASS BY PROG TO CHAR TO PRINT RUNTIME (↑T)
2,,HUPSI ;4: ASS BY PROG TO DATAPHONE HANGUP
0
0 ;6: OV, FOV, NODIV, FXU (SHOULDN'T BE ENABLED)
0
0
1,,[UTRAP [ASCIZ /Pushdown overflow/]] ;9: PDL OVERFLOW
1,,EOFPSI ;10: END OF FILE
1,,DATPSI ;11: FILE DATA ERROR
1,,[UTRAP [ASCIZ /File err 3/]] ;12: "FILE COND 3" (AS YET UNDEF)
1,,[UTRAP [ASCIZ /File err 4/]] ;13: "FILE CONDITION 4" ( " " " )
0 ;14: TIME OF DAY.
1,,ILIPSI ;15-18: I>>, MR>>, MW>>, MX>>
1,,[UTRAP [ASCIZ /Illegal memory read/]]
1,,[UTRAP [ASCIZ /Illegal memory write/]]
1,,[UTRAP [ASCIZ /Illegal memory execute/]]
0 ;19: SUBSIDIARY FORK TERMIATED (SHDN'T BE ON)
1,,[UTRAP [ASCIZ /System storage capacity exceeded/]] ;20:DRM,DSK
REPEAT 3,<0> ;21-23: UNASSIGNED
REPEAT ↑D12,<0> ;24-35: GENERAL
IFN .-CHNTAB-↑D36,<PRINTX CHNTAB SCREWED UP
>
;SPECIFIC EXEC COMMAND ROUTINES
;THESE ROUTINES ARE DISPATCHED TO BY THE MAIN LOOP, AS DRIVEN
;BY THE TABLES
;THE COMMAND ROUTINES ARE GROUPED AS FOLLOWS:
; REST OF XMAIN.MAC:
; STATUS COMMANDS GROUP -- STATUS, JOBSTAT, RUNSTAT, USESTAT,
; FILSTAT, DSKSTAT, SYSTAT, STATISTICS, ERRSTAT, MEMSTAT.
; TERMINAL CHARACTERISTICS COMMANDS GROUP -- HALFDUPLEX, FULLDUPLEX,
; TABS, FORMFEED, LOWERCASE, NO ... , INDICATE.
; X1CMD.MAC:
; OTHER COMMANDS, IN ALPHABETICAL ORDER.
; MOST PRIVILEGED COMMANDS.
; X2CMD.MAC, X3CMD.MAC, X4CMD.MAC, X5CMD.MAC:
; SOME COMMANDS WITH LONG ROUTINES, SEGREGATED TO REDUCE
; NORMAL WORKING PAGE SET:
; X2CMD.MAC: COPY, LIST/TYPE, REDIRECT/DETACH
; X3CMD.MAC: DIRECTORY,
; X4CMD.MAC: CREATE, PRINT
; X5CMD.MAC: NETLOAD
; ABOVE IN XMAIN.MAC:
; /, \, VERSION
;.STATU .JOBST JOBST0
;STATUS COMMANDS GROUP
;STATUS
.STATU: TYPE < The status commands available are:
PISTAT, DISCUSE, IMPSTAT, STATISTICS, ERRSTAT,
JOBSTAT, RUNSTAT, USESTAT, MEMSTAT, FILSTAT, DSKSTAT, and SYSTAT.
>
RET
;JOBSTAT
.JOBST: ETYPE < TSS job %J, user %N%, %L%
>
JOBST0: RET ;REST REMOVED TILL GFRKS DONE. 5/22/70 ←←←←←←←←←←←←←←
REPEAT 0, <
;TYPE FORK STRUCTURE
MOVEI A,400000 ;SAY START AT SELF
MOVEI B,CSBUF ;USE STRING BUFFER
TLO B,B0 ;SAY ASSIGN HANDLES
GFRKS ;GET FORK STRUCTURE
HRRZ D,(B) ;POINTER TO FORKS INFERIOR
SETZ E, ;INITIALIZE LEVEL COUNTER
;FALL INTO FSTRUC
;"FSTRUC" MUST BE NEXT
;FSTR1 FSTR2 FSTRUC
;FSTRUC
;RECURSIVE SUBR TO TYPE FORK STRUCTURE OF JOB.
;FOR EACH FORK, TYPES HANDLE AND STATUS.
; FILE NAME OR "PROGRAM" WOULD ALSO BE DESIRABLE IF IT WERE AVAILABLE.
;STRUCTURE INDICATED BY PUTTING A FORK'S INFERIORS RIGHT AFTER IT,
; INDENTING 3 COLUMNS PER LEVEL.
;THUS PARELLEL FORKS ARE THOSE WHICH APPEAR AT SAME INDENTATION WITH
; NO LESS-INDENTED ENTRIES BETWEEN THEM.
;TAKES: D: POINTER TO GFRKS TABLE, SET UP BY CALLER.
; E: LEVEL COUNTER, ZEROED BY TOP LEVEL CALLER.
;ENTRY POINT IS AT END BUT COMES RIGHT HERE.
;TYPE STUFF FOR THIS FORK.
FSTR1: PRINT " "
MOVE A,E
TYPE < >; ;INDENT 3 SPACES PER LEVEL BELOW FIRST.
SOJGE A,.-1
TYPE <FORK >;
HRRZ B,1(D) ;GET THIS FORK'S HANDLE FROM TABLE
JUMPE B,[UTYPE [ASCIZ /**/] ;NO HANDLE ASSIGNED
JRST FSTR2]
TRZ B,B0 ;PRINT IN FORM ## NOT 4000##
MOVE A,COJFN
MOVEI C,10
NOUT ;FORK HANDLE, OCTAL
CALL JERRC ;JSYS ERROR ROUTINE FOR ERROR NUM IN C
FSTR2: TYPE <: >;
HRRZ A,1(D) ;HANDLE AGAIN
CALL FSTAT ;TYPE ITS STATUS
PRINT EOL
;NOW DO ALL OF THE FORK'S INFERIORS, BY RECURSION.
PUSH P,D
HRRZ D,(D) ;INFERIOR PTR FROM GFRKS TABLE.
AOS E ;DOWN LEVEL
CALL FSTRUC ;RECURSIVE CALL TO DO ENTIRE SUBTREE
SOS E ;UP LEVEL
POP P,D
HLRZ D,(D) ;PARALLEL PTR FROM GFRKS TABLE
;ENTRY POINT. NOP IF 0 PTR GIVEN.
FSTRUC: JUMPN D,FSTR1
RET
>
;.RUNST RUNST8 LAPRNT
;RUNSTAT
.RUNST: PRINT " "
SKIPGE FORK
JRST [ UTYPE [ASCIZ /No program/]
JRST RUNST8]
SKIPGE A,LRFORK
JRST [ UTYPE [ASCIZ /Never started/]
JRST RUNST8]
ETYPE <%F%> ;TYPE "FORK N" IF THIS EXEC HAS >1 INFERIOR
CALL FSTAT ;TYPE STATUS OF THE FORK
RUNST8: PRINT EOL
CALL LAPRNT ;PRINT THE LOAD AVERAGE
JRST EOLRET
;SUBROUTINE TO PRINT THE LOAD AVERAGE.
;USED BY ↑T INTERRUPT AND BY RUNSTAT
LAPRNT: MOVE A,['SYSTAT']
CALL $SYSGT
JUMPN B,.+2
CALL SCREWUP ;NO SUCH TABLE??
MOVSI A,14 ;INDEX OF 1 MIN. AV.
HRR A,B ;TABLE PTR
GETAB
CALL SCREWUP
ETYPE < Load av = %1Q>
RET
;FSTAT FSTAT4 FSTAT8 FSTAT9
;FORK STATUS TYPEOUT SUBR FOR "RUNSTAT" AND "JOBSTAT".
;TAKES HANDLE IN A, CLOBBERS A.
;USED IN FSTRUC (JOBSTAT), RUNSTAT, ↑T PSI ROUTINE (XSUBRS.MAC)
FSTAT: PUSH P,B
PUSH P,C
PUSH P,D
RFSTS ;GET STATUS IN A, PC IN B
HLRZ C,A ;B1-17 = STATUS
CAIN C,-1 ; -1 = UNASSIGNED HANDLE. (OR SUPERIOR?)
JRST [ MOVEI D,[ASCIZ /Program disappeared/]; ..KILLED PROGRAM
JRST FSTAT8]
TRZ C,B0 ;FLUSH FROZEN BIT
CAIN C,6 ;BREAKPOINT?
JRST FSTAT4 ;YES
CAIE C,2 ;HALT OR FORCED TERM?
CAIN C,3
FSTAT4: TLZ A,B0 ;YES, WASN'T RESULT OF ↑C
JUMPL A,[UTYPE [ASCIZ /Interrupted from /] ;"FROZEN" BIT ON
JRST .+1] ;TYPE STATUS AND PC
UTYPE @[[ASCIZ /running/]
[ASCIZ \I/O wait\]
[ASCIZ /halt/] ;INCLUDES NEVER STARTED
[ASCIZ /halt: /]
[ASCIZ /fork wait/]
[ASCIZ /sleep/]
[ASCIZ /breakpoint/]](C) ;NOTE INDEX!
MOVEI D,[ASCIZ / at %2P/] ;%2P TYPES PC FROM B
CAIE C,3
JRST FSTAT8 ;GO OUTPUT "AT <PC>"
;AFTER ERROR STOP, TYPE REASON AS GIVEN
;BY PSI CHAN # IN RH OF A. USE TEXT
;FROM "START" COMMAND'S ERROR MSG TAB.
MOVE D,@WHY ;SEE "START". USES A.
FSTAT8: UETYPE (D) ;TYPE MSG. INCLUDES PC FROM B.
FSTAT9: POP P,D
POP P,C
POP P,B
RET
;.PISTA Job TIW
;PISTAT
;PSI IS OFF, LEVTAB=NNNNNN, CHNTAB=NNNNNN, CHN MASK=NNNNNNNNNNNN, BIP=N
.PISTA: CALL CRIF
SKIPGE 1,FORK
JRST [ UTYPE [ASCIZ /No program/]
JRST EOLRET]
UTYPE [ASCIZ /PSI is /]
MOVEI 5,[ASCIZ /on/]
SKPIR
MOVEI 5,[ASCIZ /off/]
UTYPE 0(5)
RIR
HLRZ 4,2 ;LEVTAB
HRRZ 5,2 ;CHNTAB
RCM
MOVE 6,1 ;CHN MASK
MOVE 1,FORK
RWM
MOVE 7,1 ;BREAKS WAITING
MOVE 10,2 ;BREAKS IN PROGRESS
AND 10,[17B3]
MOVE 1,FORK
RTIW
MOVE 11,2 ;USER TIW
MOVNI 1,5
RTIW
MOVE 12,2 ;JOB TIW
ETYPE <, LEVTAB at %4O, CHNTAB at %5O
Channels active: %6U
Breaks waiting: %7U
Levels in progress: %10U
Fork TIW: %11O
Job TIW: %12O>
RET
;.IMPST IMPST0 IMPST1 IMPST2 IMPST3 IMPST4 IMPS45 IMPST5 IMPST6 IMPSTX
; "IMPSTAT"
.IMPST: MOVE A,['NETRDY']
CALL READT ;READ INTO 4, 5, ...
SUBI C,4 ;NEW SYSTEMS HAVE LENGTH .GT. 4
PUSH P,C ;NEW SYSTEM FLAG
PUSH P,13 ;NETRDY[7]: TIME OF IMP-GOING-DOWN MSG
PUSH P,12 ;NETRDY[6]: TIME OF READY LINE ON
PUSH P,11 ;NETRDY[5]: TIME OF READY LINE OFF
PUSH P,10 ;NETRDY[4]: IMP-GOING-DOWN HEADER
PUSH P,7 ;NETRDY[3]: TIME OF LAST NCP RESET
PUSH P,6 ;NETRDY[2]: NCP FLAGS (N.A.)
PUSH P,5 ;NETRDY[1]: NETON
PUSH P,4 ;NETRDY[0]: IMPRDY
MOVE 1,COJFN ;NEEDED FOR ODTIM'S BELOW
IMPST0: CALL CRIF ;TYPE CARRIAGE RETURN IF NEEDED
TYPE <Host-IMP interface is >
SKIPN 0(P)
TYPE <off>
SKIPE 0(P)
TYPE <on>
IMPST1: CALL CRIF
TYPE <Tenex-network service is >
SKIPN -1(P) ;NETRDY[1] SAYS WHICH
TYPE <disabled>
SKIPE -1(P)
TYPE <enabled>
IMPST2: SKIPG -8(P) ;NEW SYSTEM?
JRST IMPSTX ;NO
IMPST3: SKIPN -1(P) ;NCP RESET RELEVANT ONLY IF NETON
JRST IMPST4 ;NOT AVAILABLE
CALL CRIF
SKIPG 2,-3(P) ;NETRDY[3] HAS LAST NCP RESET
TYPE <Tenex has not reset network tables since last restarted>
JUMPLE 2,IMPST4 ;0 IS AMBIGUOUS
TYPE <Tenex reset network tables at >
SETZ 3, ;STANDARD FORMAT
ODTIM
IMPST4: SKIPN 2,-7(P) ;GTAD OF IMP-GOING-DOWN MSG ARRIVAL
JRST IMPST5 ;NONE HAS ARRIVED
CALL CRIF
SKIPG 2
TYPE <While Tenex was restarting the IMP said it would go down
>
JUMPL 2,IMPS45 ;-1 MEANS SYSTEM DIDN'T HAVE TIME
TYPE <At >
SETZ 3, ;STANDARD FORMAT
ODTIM
TYPE < the IMP said it would go down at >
MOVE 1,2
LDB 2,[POINT 4,-4(P),21];HOW SOON IN 5 MIN. UNITS
IMULI 2,5
CALL TIMPMN ;GTAD IN 1 PLUS MINUTES IN 2
MOVE 2,1 ;SET FOR ODTIM
MOVE 1,COJFN
SETZ 3, ;STANDARD FORMAT
ODTIM
IMPS45: TYPE < for >
LDB 2,[POINT 10,-4(P),31];HOW LONG IN 5 MIN. UNITS
IMULI 2,5
MOVEI 3,↑D10
NOUT
CALL JERRC
TYPE < minutes due to >
LDB 2,[POINT 2,-4(P),17];REASON FIELD
CAIN 2,0
TYPE <panic>
CAIN 2,1
TYPE <scheduled hardware PM>
CAIN 2,2
TYPE <scheduled software reload>
CAIN 2,3
TYPE <emergency restart>
IMPST5: CALL CRIF
SKIPN 2,-5(P) ;NETRDY[5] IS READY LINE OFF TIME
TYPE <The ready line has not gone off since Tenex was restarted>
JUMPE 2,IMPST6
TYPE <Most recent ready line off was >
SKIPG 2
TYPE <when Tenex was restarting>
SETZ 3, ;STANDARD FORMAT
SKIPL 2
ODTIM
IMPST6: CALL CRIF
SKIPN 2,-6(P) ;NETRDY[6] IS READY LINE ON TIME
TYPE <The ready line has not come on since Tenex was restarted>
JUMPE 2,IMPSTX
TYPE <Most recent ready line on was >
SKIPG 2
TYPE <when Tenex was restarting>
SETZ 3, ;STANDARD FORMAT
SKIPL 2
ODTIM
IMPSTX: SUB P,[9,,9] ;FLUSH TEMPS
PRINT EOL
PRINT EOL
RET
;.USEST
;USESTAT
.USEST: ETYPE < Used %B% in %C%
>
;ADD CODE TO TYPE USAGE OF RTI, E&S, ETC., IF USED
RET
;.DSKST .DISCU DSKCNT DSKST1 DSKST2 DSKST3 DSKST5 DSKST4 CHKDAL
;DSKSTAT
.DSKST: CALL DSKCNT ;COUNT PAGES
ETYPE < %7Q Total pages in use - %5Q allowed, %4Q undeleted, %6Q deleted
>
TLNE Z,B3
ETYPE < excluding file(s) that are list protected from you
>
; "DISCUSE"
.DISCU: MOVE A,[600000,,777777] ;DSK: DESIGNATOR
GDSKC
ETYPE < System total: %2Q pages left, %1Q used
>
JRST RLJFNS ;RELEASE JFNS AND RETURN
DSKCNT: SETZB D,F ;FOR SUMS OF TOTAL AND DELETED PAGES
SETO A,
MOVE C,JBUFP
PUSH C,A
HRLZI A,B2+B8+B11+B17 ;OLD, *'S, SHORT CALL, INCL. DELETED
HRROI B,[ASCIZ /*.*;*/]
GTJFN
CALL [ CAIE A,GJFX20
CAIN A,GJFX32
JRST [ SUB P,[1,,1] ;FOR NO FILES IN DIRECTORY,
SETZ G, ;CLEAR TOTAL
JRST DSKST5] ;TYPE "0 PAGES"
JRST JERR]
MOVEM A,(C) ;STACK JFN FOR RELEASING ON
MOVEM C,JBUFP ;UPDATE JFN STACK
MOVE E,A ; ERR OR COMPLETION
;LOOP OVER FILES WITH GNJFN
DSKST1: TLZ Z,B1 ;RESET DELETED BIT
HRRZ A,E ;JFN ONLY
MOVE B,[1,,FDBCTL] ;CONTROL BITS WORD OF FDB
MOVEI C,C ;TO BE PUT IN C
CALL $GTFDB ;GET IT
JRST DSKST2 ;COULDN'T
TLNE C,(FDBDEL) ;DELETED?
TLO Z,B1 ;YES, SAY SO
MOVE B,[1,,FDBBYV] ;# PAGES IN RH
MOVEI C,C
CALL $GTFDB ;DO GTFDB JSYS, NO SKIP IF NO ACCESS
DSKST2: TLOA Z,F3 ;SAY ACCESS ERROR AND SKIP ADD
JRST DSKST4 ;GO ADD UP PAGES
DSKST3: MOVE A,E ;JFN AND FLAGS
GNJFN ;STEP TO NEXT FILE
JRST .+2 ;NO MORE FILES
JRST DSKST1
MOVE G,D ;FORM SUM
ADDI G,(F) ;OF DELETED AND UNDELETED
DSKST5: MOVEI 1,0 ;SAY CONNECTED DIRECTORY
GTDAL ;GET ALLOCATION FOR CONN DIR
MOVE 5,1 ;SAVE FOR PRINTING
RET ;PRINT RELEVANT NUMS, RELEASE JFN
DSKST4: TLNE Z,B1 ;SUM DELETED OR UNDELETED
JRST .+3
ADDI D,(C) ;UNDELETED TOTAL
JRST DSKST3
ADDI F,(C) ;DELETED TOTAL
JRST DSKST3
;CHECK CONNECTED DIRECTORY FOR EXCEEDING DISK ALLOCATION
;USED BY LOGIN, LOGOUT, CONNECT
CHKDAL: MOVEI 1,0 ;SAY CONNECTED DIRECTORY
GTDAL
SUB 2,1 ;USED MINUS ALLOCATED
JUMPLE 2,RLJFNS ;JUMP IF NOT OVER ALLOCATION
CALL CRIF ;BE SURE CARRIAGE IS AT LEFT MARGIN
ETYPE <%G over allocation by %2Q pages.
>
JRST RLJFNS ;GO RELEASE JFN
;.MEMST MEMS1 MEMS2 MEMS3
;MEMSTAT
;TYPES, FOR CURRENT FORK, # PAGES, ENTRY VECTOR,
;AND A TABLE GIVING IDENTITY OF EACH PAGE IN FORK.
.MEMST: SKIPGE FORK
JRST [ UTYPE [ASCIZ / No program/]
JRST EOLRET]
;FIRST TYPE TOTAL # PAGES
HRLZ A,FORK
PUSH P,[1000] ;HOW MANY PAGES TO DO
SETZ D,
MEMS1: RPACS ;CLOBBERS C IF PAGE LOCKED
TLNE B,B5
AOS D
AOS A
SOSLE C,0(P) ;MORE PAGES TO BE DONE?
JRST MEMS1 ;YES
SUB P,[1,,1] ;FLUSH JUNK
PRINT EOL
CAIN D,1
JRST [ UTYPE [ASCIZ / One page/]
JRST MEMS2]
ETYPE < %4Q pages>;
;PRINT ENTRY VECTOR
MEMS2: MOVE A,FORK
GEVEC
JUMPE B,MEMS3 ;NONE
HRRZ A,B
HLRZ B,B
ETYPE <, entry vector location %1O length %2O>
MEMS3: PRINT EOL
JUMPE D,[RET] ;DONE IF NO PAGES
PRINT EOL
;NOW FALL INTO "MMAP" TO TYPE MAP
;MMAP MMAP1 MMAP2 MMAP6 MMAP7
;SUBROUTINE TO TYPE MEMORY MAP FOR CURRENT FORK, FOR MEMSTAT.
;ACS: D: PAGE #
; E & F: IDENTITY OF CURRENT PAGE, A LA RMAP A & B.
; KWV, KWV1: SAVED IDENTITY OF 1ST PAGE OF GROUP.
; G: INCREMENT FOR PAGE # IN GROUP OF CONSECUTIVE PAGE IDENTITIES.
MMAP: SETZ D,
;FIND EXISTING PAGE (TREAT INDIRECT POINTERS AS EXISTING)
MMAP1: HRL A,FORK
MMAP2: CAIL D,1000
JRST EOLRET ;NO MORE PAGES, DONE
HRR A,D
RPACS
TLNN B,B5+B6
AOJA D,MMAP2 ;DOESN'T EXIST, TRY NEXT
;FOUND ONE, PRINT NUMBER
CALL PAGID ;GET FULL IDENTITY
JRST .+2 ;3-RETURN SUBR, BUT IRRELEVANT HERE.
JRST .+1
MOVE KWV,E ;SAVE IDENTITY FOR LATER COMPARISONS
MOVE KWV1,F ;...AND PRINTING
SETZ G, ;INIT # CONSECUTIVE IDENTITIES
HRRZ B,D
CALL TOCT ;PRINT PAGE NUMBER IN OCTAL
;LOOK AT IDENTITY OF NEXT PAGE
CALL NPAGID ;STEPS D AND GETS IDENTITY
SOJA G,MMAP10 ;DIFFERENT, GO TYPE IDENTITY
JRST MMAP6 ;NEXT HIGHER IN SAME FILE OR FORK
;IDENTICAL, SEE HOW MANY MORE ARE
CALL NPAGID
JRST .+3 ;DIFFERENT
JRST .+2 ;NEXT HIGHER
JRST .-3 ;IDENTICAL, KEEP LOOKING
SETZ G, ;SAY IDENTICAL NOT CONSECUTIVE GROUP
JRST MMAP7 ;GO PRINT "-# <FILE OR FORK> #
;NEXT HIGHER OF SAME FILE OR FORK, SEE HOW MANY MORE ARE CONSECUTIVE
MMAP6: CALL NPAGID
JRST .+2 ;DIFFERENT
JRST .-2 ;CONSECUTIVE, KEEP LOOKING
;PRINT "-#" FOR GROUP OF IDENTICAL OR CONSECUTIVE PAGES
MMAP7: PRINT "-"
MOVEI B,-1(D) ;LAST IN GROUP WAS THE PREVIOUS PAGE
CALL TOCT ;TYPE IN OCTAL
;MMAP10 MMAP11 MMAP13
;MMAP...
;PRINT IDENTITY OF PAGES WHOSE #'S WE HAVE JUST PRINTED:
;TYPICALLY FORK OR FILE NAME, # FOR A SINGLE PAGE OR IDENTICAL GROUP,
; #-# FOR CONSECUTIVE GROUP. ALL PRECEDED BY @ IF INDIRECT.
MMAP10: PRINT TAB
PRINT " "
TLNE KWV1,B6
UTYPE [ASCIZ /@ /] ;INDICATE INDIRECT POINTER
TLNN KWV1,B5 ;DOES PAGE EXIST?
JRST [ UTYPE [ASCIZ /No page/] ;CAN HAPPEN WITH INDIRECT.
JRST MMAP13]
TLNE KWV1,B10
JRST [ UTYPE [ASCIZ /Private/]
JRST MMAP13]
CAMN KWV,[-1] ;RMAP RETURNS -1 IF NO JFN FOR FILE
JRST [ UTYPE [ASCIZ /Forgotten file/]
JRST MMAP13]
LDB B,[POINT 9,KWV,17] ;JFN OR FORK #
TLNE KWV,B0 ;ON IF FORK
JRST [ UETYPE [ASCIZ /Fork %2O/]
JRST MMAP11]
MOVE A,COJFN
SETZ C,
JFNS ;PRINT FILE NAME
MMAP11: TYPE < >;
HRRZ B,KWV
CALL TOCT ;PAGE # IN FILE OR FORK
JUMPLE G,MMAP13 ;0 INDICATES ONE PAGE ONLY
PRINT "-"
ADDI B,-1(G) ;DON'T COUNT LAST PAGE TESTED!
CALL TOCT ;PRINT LAST PAGE OF CONSECUTIVE GROUP
MMAP13: TYPE ( )
TLZ Z,F1 ;USED BY "BEFORE"
TLNN KWV1,B2
JRST .+3
CALL BEFORE ;TYPE COMMA OR EOL BETWEEN ITEMS
PRINT "R"
TLNN KWV1,B3
JRST .+3
CALL BEFORE ;SUBR WITH "AVAIL DEVICES"
PRINT "W"
TLNN KWV1,B9
JRST .+3
CALL BEFORE
TYPE <CW>; ;COPY-ON-WRITE
TLNN KWV1,B4
JRST .+3
CALL BEFORE
PRINT "E"
TLNN KWV1,B7 ;LOCKED BY USER BIT
JRST .+3
CALL BEFORE
PRINT "L"
PRINT EOL
JRST MMAP1 ;GO BACK FOR ANOTHER PAGE OR GROUP
;NPAGID PAGID PAGID8 PAGID9
;SUBROUTINE FOR MMAP TO GET AND COMPARE IDENTITY OF PAGE
;TAKES IN D: PAGE #, IN KWV, KWV1: IDENTITY OF FIRST PAGE IN GROUP,
; IN G: PAGE # INCREMENT FOR CONSECUTIVE GROUP.
;RETURNS: E, F: IDENTITY OF PAGE, A LA RMAP.
; +1: DIFFERENT IDENTITY FROM FIRST PAGE OF GROUP
; +2: NEXT HIGHER PAGE # (THAN KWV1+G, G), G INDEXED
; +3: IDENTICAL
;IF D > 777, BEHAVES AS THOUGH CURRENT PAGE IS NON-EXISTENT.
;CLOBBERS A,B.
NPAGID: ADDI D,1 ;ENTRY FOR NEXT PAGE
ADDI G,1
PAGID: MOVE A,D ;ENTRY TO NOT INDEX PAGE #
SETZ E, ;FOR NON-EXISTENT OR PRIVATE PAGE
CAIL A,1000
JRST [ HRLZI F,B5 ;PAGES OVER 777 DON'T EXIST
JRST PAGID8]
HRL A,FORK
RPACS
HLLZ F,B ;RETURN RPACS INFO IN F
TLNE B,B5 ;DOESN'T EXIST?
TLNE B,B10 ;PRIVATE?
JRST PAGID8 ;THIS IS ALL THE INFO WE NEED.
RMAP ;GET FILE/FORK HANDLE AND PAGE # THEREIN
MOVE E,A ;...INTO E.
;COMPARISON TO DETERMINE WHETHER SAME AS PREVIOUS PAGE
;COMPARE THAT INFO WHICH IS PRINTED:
; ALL E, F BITS 2-6, 9, 10.
PAGID8: MOVE A,E
XOR A,KWV
TLNE A,-1
JRST PAGID9 ;DIFFERENT FILES OR FORKS, R1
MOVE B,F ;RMAP'S ACCESS IS WRONG (1/22/71)
XOR B,KWV1
TLNE B,<37B6+1B7+3B10>B53
JRST PAGID9 ;DIFFERENT ACCESS, R1.
TRNE A,-1
JRST [ MOVE A,G
ADD A,KWV
SUB A,E
TRNE A,-1
JRST .+3 ;REALLY DIFFERENT PAGE, R1
JRST .+2] ;NEXT HIGHER PAGE #, R2
AOS (P) ;SAME IDENTITY INCLUDING PAGE #, R3.
AOS (P)
PAGID9: RET
;.FILST ASTTJ
;FILSTAT
.FILST: PRINT EOL
GJINF
CAME A,B ;COMPARE LOGIN AND CONNECTED DIRECTORIES
ETYPE < Connected to <%G%>. >;
;JFNS
TYPE < JFNs:
>
MOVEI D,MAXJFN ;JFN AND COUNTER
CALL JSTAT ;TYPE INFO IF JFN ASSIGNED
SOJGE D,.-1
PRINT EOL
;DEVICES ASSIGNED TO THIS JOB
PUSH P,[[TLNE Z,F1 ;SET RETURN FOR ASTTJ
PRINT EOL
RET]]
;"AVAILABLE DEVICES" ALSO COMES HERE TO TYPE DEVS ASS TO THIS JOB.
ASTTJ: GJINF ;GET JOB # IN C
MOVE E,C
TLZ Z,F1
CALL DEVLUP ;GET NAME & CHARACTERISTICS FOR EACH
;DEVICE AND EXECUTES THE NEXT LOCATION.
CALL [ CAME C,E ;ASSIGNED TO THIS JOB?
RET ;NO.
TLNN Z,F1 ;FIRST ONE? ("BEFORE" SETS F1)
UTYPE [ASCIZ / Devices assigned to this job:/]
CALL BEFORE ;COMMA OR CR OR NIL. AFTER "AVAIL DEV".
JRST SIXPRT] ;PRINT SIXBIT NAME FROM A.
TLNE Z,F1
PRINT EOL
RET
;JSTAT ILIJFN
;TYPE STATUS OF JFN IN RH OF D.
;NOP IF UNASSIGNED.
;IF ASSIGNED, TYPE <JFN> <NAME>
;AND WHAT OPEN FOR AND "NOT OPEN" OR "DATA ERROR" OR "EOF" IF PERTINENT.
;DESTROYS A, B, C, E. USED IN "FILSTAT".
JSTAT: HRRZ A,D
GTSTS
TLNN B,200
RET ;UNASSIGNED, RETURN.
MOVE E,B ;STATUS FOR USE BELOW
PRINT " "
MOVE A,COJFN
HRRZ B,D
MOVE C,[4,,10]
NOUT ;JFN, LEFT ADJ IN 4 COLS
CALL JERRC
HRRZ B,D
SETZ C, ;DEFAULT FORMAT
MOVEI A,ILIJFN
MOVEM A,ILIDSP ;SET SPECIAL ILLEGAL INSTRUCTION DISPATCH
MOVE A,COJFN ;PRIMARY OUTPUT JFN
JFNS ;PRINT NAME OR TRAP
SETZM ILIDSP ;CANCEL INSTRUCTION TRAP
JRST JSTAT2
;HERE IF JFNS TRAPS
ILIJFN: TLNN E,(1B17) ;LOOK AT STATUS WORD
JRST ILIPSI ;TRAPPED FOR SOME OTHER REASON
TYPE <Restricted to some other fork>
PRINT EOL
RET ;FROM JSTAT
;JSTAT2 JSTAT3 JSTAT4 JSTAT5 JSTAT6 JSTAT7 JSTAT8 JSTAT9 JSTA10
;JSTAT...
;TYPE "NOT OPEN" OR LIST OF "READ", "EXECUTE", ETC.
;IF B0 ON AND B1-3 & 5-6 OFF, TYPES NOTHING. CAN THIS HAPPEN? ←←←←←←
JSTAT2: PRINT TAB
TLZ Z,F1 ;TELL "BEFORE" NOTHING HAS BEEN PRINTED
TLNN E,B0
TYPE < Not opened>;
TLNN E,B1
JRST JSTAT3
CALL BEFORE ;TYPE SPACE OR COMMA-SPACE OR EOL-SPACE
TYPE <Read>;
JSTAT3: TLNN E,B2 ;OK TO WRITE
JRST JSTAT4
CALL BEFORE
TLNN E,B4 ;ALSO OK TO CHANGE POINTER?
TYPE <Append>; ;NO
TLNE E,B4
TYPE <Write>; ;YES
JSTAT4: TLNN E,B3 ;EXECUTE
JRST JSTAT5
CALL BEFORE
TYPE <Execute>;
JSTAT5: TLNN E,B5 ;AS SPECIFIED BY PAGE TABLE
JRST JSTAT6
CALL BEFORE
TYPE <Per page table>;
JSTAT6: TLNN E,B6 ;CALL AS PROCEDURE
JRST JSTAT7
CALL BEFORE
TYPE <Procedure>;
JSTAT7: TLNN E,B9
JRST JSTAT8
CALL BEFORE
TYPE <Data error>;
JSTAT8: TLNN E,B8
JRST JSTAT9
CALL BEFORE
TYPE <EOF>;
JSTAT9: TLNE E,B1!B2
TLNN E,B0
JRST JSTA10
TLNE E,B3!B6
JRST JSTA10
HRRZ A,D
RFPTR
CALL JERR
CALL BEFORE
MOVE A,COJFN
MOVEI C,12
NOUT
CALL JERRC
MOVEI B,"."
BOUT ;INDICATE DECIMAL
JSTA10: JRST EOLRET
;.SYSTA SYST1 SYST2 SYST3
;SYSTAT
.SYSTA: CALL CRIF ;TYPE CRLF-SPACE IF NEEDED
MOVE A,['SYSTAT']
MOVEI B,14
CALL MORET ;GET LOAD AVERAGES
ETYPE < Load %4Q %5Q %6Q Up %K %I %D %E
>
CALL LGNCHK ;TYPE MSG IF NOT PERMITTING LOGINS
CALL DWNTIM ;PRINT SHUTDOWN WARNING, IF ANY
MOVE A,['NCPGS ']
CALL $SYSGT
ETYPE < %1Q pages of user core >
TLZA Z,F3 ;NORMAL VERSION
;SPECIAL HACK FOR MGM'S INFERIOR TERMINALS
.QSYSTAT: TLO Z,F3 ;QUICK VERSION (ONLY P1)
TLZ Z,F1+F2 ;START WITH PASS ONE
;LOOP TO TYPE TSS JOB #, TTY #, USER FOR EACH JOB
SYST1: SETO D,
GTB 1 ;GET # POSSIBLE JOBS
HRLZ D,A ;AOBJN COUNT,,JOB #
;TOP OF LOOP
SYST2: GTB 1 ;TABLE 1: POSITIVE IF JOB EXISTS
JUMPL A,SYST9
;HAVE A REAL JOB #. PRINT IT.
GTB 0
HLRE B,A
CAIN B,20 ;FIB GOES ON PASS 2
TLNN Z,F2
CAIA
JRST SYST3
TLNN Z,F2 ;IF PASS 1 ...
JUMPLE B,SYST9 ;IGNORE DETACHED JOBS AND TTY0
TLNE Z,F2 ;IF PASS 2 ...
JUMPG B,SYST9 ;IGNORE NON-DETACHED JOBS EXCEPT TTY0
HLRZ B,A
CAIN B,20 ;FIB GOES ON PASS 2
TLNE Z,F2
CAIA
JRST SYST9
;PRINT ONE JOB
SYST3: TLON Z,F1 ;TYPE HEADER FIRST TIME.
TYPE <
Job TTY User Subsys Pg faults CPU <Connected>[Foreign host]
>
PRINT " "
HRRZ B,D
MOVE A,COJFN
MOVE C,[4,,↑D10] ;LEFT ADJ IN 4 COLS, DECIMAL
NOUT ;CONVERT AND PRINT JOB #
CALL JERRC
;"DET" OR "TTY N"
GTB 0 ;TABLE 0: LH NEG OR LINE # FOR THIS JOB
JUMPL A,[UTYPE [ASCIZ /Det /]
JRST SYST4]
HLRZ B,A
MOVE A,COJFN
MOVE C,[5,,10] ;LEFT ADJ IN 5 COLS, OCTAL
NOUT ;LINE #.
CALL JERRC
;SYST4 SYST5 SYST5A SYST8 SYST8A SYST8Y SYST9 SYST8X SYST8W
;SYSTAT...
;SUBSYSTEM NAME
;USER NAME OR "?" IF CONVERSION FAILS.
SYST4: GTB 3 ;TABLE 3: RH: USER'S DIR #
HRREI B,(A) ;0 IF NOT LOGGED IN
JUMPLE B,[UTYPE [ASCIZ /Not logged in /]
JRST SYST8Y]
MOVE A,COJFN
DIRST ;CONVERT DIR # TO STRING AND PRINT
PRINT "?" ;NOT FOUND (NO SYSTEM ERROR # IN A)
SYST5: MOVE A,[SIXBIT /JOBNAM/]
CALL $SYSGT ;GET # OF TABLE CONTAINING SNAMES INDICES
JUMPE B,SYST8 ;NO SUCH TABLE: NOT IMPLEMENTED YET
HRR A,B ;TABLE NUMBER
HRL A,D ;INDEX: TSS JOB #
GETAB ;GET SNAMES INDEX INTO A
CALL JERR
MOVE C,A
MOVE A,[SIXBIT /SNAMES/]
CALL $SYSGT ;GET # OF SUBSYSTEM NAMES TABLE
JUMPE B,SYST8
HRR A,B
HRL A,C ;INDEX FROM TABLE JOBNAM
GETAB
CALL JERR
PUSH P,A
;POSITION CARRIAGE, TYPING A MAXIMUM OF 10 SPACES
MOVEI C,12
SYST5A: PRINT " "
MOVE A,COJFN
RFPOS ;VALID ONLY FOR TTYS
MOVEI B,(B) ;MASK HORIZ POSITION
CAIGE B,24
SOJGE C,SYST5A
POP P,A ;NAME AGAIN
JUMPE A,[PRINT "?"
JRST SYST8]
CALL SIXPRT ;PRINT IT
;SIXPRT IS WITH "AVAIL DEV" IN X1CMD.MAC
SYST8: MOVEI C,12
SYST8A: PRINT " "
MOVE A,COJFN
RFPOS ;VALID ONLY FOR TTYS - ELSE RETS 0
MOVEI B,(B) ;MASK HORIZ POSITION
CAIGE B,24+6+2
SOJGE C,SYST8A
GTB 12 ;JOB PAGE FAULTS
MOVE B,A
MOVE C,[1B2+9B17+↑D10]
MOVE A,COJFN
NOUT
JFCL
GTB 1 ;CPU TIME
MOVE B,A
MOVE C,[1B2+9B17+↑D10]
MOVE A,COJFN
NOUT
JFCL
PUSHJ P,SYST8X ;CONN DIR
SYST8Y: GTB 0
HLRZS A
PUSHJ P,WHERE4 ;PRINT FOREIGN HOST IF ANY
JFCL
PRINT EOL
SYST9: AOBJN D,SYST2
TLNE Z,F3
JRST EOLRET ;QUICK VERSION, ONLY PASS1
TLON Z,F2 ;SWITCH TO PASS2
JRST SYST1 ;AND PRINT THE REST
JRST EOLRET
;
; PRINT CONNECTED DIRECTORY
;
SYST8X: PUSH P,A
GTB 3
HLRZ B,A
HRRZ C,A
CAMN B,C
JRST SYST8W
MOVE A,COJFN
PRINT "<"
DIRST
JFCL
PRINT ">"
SYST8W: POP P,A
POPJ P,
;.STATI
;STATISTICS
.STATI: CONFIRM ;CAN'T USE TABLE BIT "ONEWD" BECAUSE
;FUDGE-ENTRY FOR "STAT" TYPES OUT AFTER DISPATCH
MOVE A,[SIXBIT /SYSTAT/]
CALL READT ;READ SYSTEM STATISTICS TABLE INTO AC'S 4-13
ETYPE <
Idle %4T waiting %5T core management %6T pager traps %7T
Swap reads %10Q writes %11Q DSK reads %12Q writes %13Q
>
MOVE A,[SIXBIT /NCPGS/]
CALL $SYSGT
ETYPE < %1Q pages of user core
>
MOVE A,[SIXBIT /SYSTAT/]
MOVEI B,10
CALL MORET ;READ MORE OF TABLE
TIME ;TOTAL UPTIME OF SYSTEM
CALL FLOAT
EXCH 1,6
CALL FLOAT ;FLOAT NBAL TOTAL
EXCH 1,7
CALL FLOAT ;FLOAT NRUN TOTAL
EXCH 1,6
FDVR 6,1 ;NRUN AVERAGE
FDVR 7,1 ;NBAL AVERAGE
ETYPE < %4Q terminal wakeups %5Q terminal interrupts
NBAL average %7Q NRUN average %6Q
>;
MOVE A,[SIXBIT /QTIMES/]
CALL READT
ETYPE < Runtime of jobs on queues 0-5 (msec)
%4Q %5Q %6Q %7Q %10Q %11Q
>;
;STAT3 STAT51 STAT5A STAT6A STAT6B STAT6C STAT6E STAT6F STAT6G STAT5C STAT5Y STAT5Z STAT6 STAT5N SNAMS
;STATISTICS...
;TABLE OF SUBSYSTEM USAGE
STAT3: TYPE <
Subsys Time Pg Flts Time/Flt Av W-set Flt/Wake
>
MOVEI 6,1(P) ;PLACE ON STACK TO STORE TABLE NUMBERS
HRLI 6,5
ADD P,[NSNAMS,,NSNAMS]
MOVSI 5,-NSNAMS ;NUMBER OF TABLES TO EXAMINE
STAT51: MOVE A,SNAMS(E) ;GET SIXBIT NAME OF TABLE
CALL $SYSGT
MOVEM B,@6 ;SAVE TABLE NUMBER
AOBJN 5,STAT51
HLLZ 4,0(6) ;LENGTH OF (FIRST) TABLE
STAT5A: MOVSI 5,-NSNAMS ;TABLE COUNTER FOR EACH SUBSYS
HRRZ A,@6
GTB (A) ;GET NAME OF SUBSYSTEM IN THIS SLOT
JUMPE A,STAT5Z ;0 MEANS NONE THERE
PRINT " "
CALL SIXPRT ;PRINT THE NAME
PRINT TAB
AOBJN 5,.+1
STAT6A: HRRZ A,@6 ;GET 2ND ENTRY
GTB (A) ;GET TIME
PUSH P,A ;SAVE FOR LATER
MOVE B,A
CALL STAT5N ;PRINT IT
AOBJN 5,.+1 ;KEEP POINTER UP TO DATE
STAT6B: HRRZ A,@6 ;GET FAULTS
GTB (A)
MOVE B,A
CALL STAT5N ;PRINT IT
AOBJN 5,.+1 ;UPDATE
STAT6C: MOVE A,B
CALL FLOAT
EXCH A,0(P) ;FLTS TO PDL, TIME TO A
CALL FLOAT
FDVR A,0(P) ;TIME PER FAULT
ETYPE < %1Q> ;PRINT IT
STAT6E: HRRZ A,@6
GTB (A)
PUSH P,A ;WAKES & AV. WORKING SET SIZE
LDB A,[POINT 15,A,14] ;THIS WORD HAS TWO FIELDS
CALL FLOAT ;FLOAT EACH FIELD
EXCH A,0(P) ;WAKES TO PDL, WSET TO A
TLZ A,(-1B14)
CALL FLOAT
FDVR A,0(P) ;COMPUTE AVERAGE
ETYPE < %1Q>
STAT6F: MOVE A,-1(P) ;FAULTS
FDVR A,0(P) ;FAULTS/WAKEUP
ETYPE < %1Q>
STAT6G: SUB P,[2,,2] ;FLUSH JUNK
AOBJP 5,STAT5Y ;ANYMORE TABLES TO PRINT?
STAT5C: HRRZ A,@6 ;TABLE NUMBER
GTB (A) ;GET DATA
MOVE B,A
CALL STAT5N ;PRINT DECIMAL VALUE
AOBJN 5,STAT5C
STAT5Y: PRINT EOL
STAT5Z: AOBJN 4,STAT5A
SUB P,[NSNAMS,,NSNAMS] ;REMOVE TEMP STORAGE
STAT6: JRST EOLRET
;PRINT FORMATTED NUMBER
STAT5N: MOVE A,COJFN
MOVE C,[1B0+1B2+1B4+12B17+↑D10]
NOUT
JRST [ CAIE A,NOUTX2 ;CHECK FOR COLUMN OVERFLOW ERROR CODE
CAIN C,NOUTX2 ;IN A OR C
RET ;ALLOW IT
JRST JERR] ;REPORT ANY OTHER ERROR
RET
;TABLES TO BE PRINTED IN STATISTICS FOR SUBSYSTEMS
SNAMS: SIXBIT /SNAMES/ ;MUST BE FIRST
SIXBIT /STIMES/ ;MUST BE SECOND
SIXBIT /SPFLTS/ ;MUST BE THIRD
SIXBIT /SWAKES/ ;MUST BE FOURTH
;*** OTHERS MAY BE INSERTED HERE ***
NSNAMS==.-SNAMS
;.ERRST SYST11 SYST12
;ERRSTAT: PRINT VARIOUS ERROR INFORMATION
.ERRST:; MOVEI A,400000
; RPCAP
; TRNN B,1B18+1B19+1B20+1B21 ;WHEEL, CONFI, OPER, MAINT.
; JRST CERR
;DISK ERRORS
MOVE A,[SIXBIT /DSKERR/]
CALL READT ;READ DISK ERRORS TABLE INTO AC'S D + .
JUMPN D,.+2
JUMPE 11,[UETYPE [ASCIZ /
No disk errors
/]
JRST SYST11]
ETYPE <
Disk errors: %4Q recoverable >
JUMPE D,.+2
ETYPE <
Command words for last recoverable error:
%5O
%6O
%7O
Error bits: %10O
>;
ETYPE < %11Q irrecoverable
>;
JUMPE 11,.+2
ETYPE < Command words for last irrecoverable error:
%12O
%13O
%14O
Error bits: %15O
>;
;DRUM ERRORS
SYST11:
; MOVE A,[SIXBIT /DRMERR/]
; CALL READT
; JUMPE D,[UETYPE [ASCIZ /
; No drum errors
;/]
; JRST SYST12]
; ETYPE <
; %4Q drum errors
; Command words for last error:
; %5O
; %6O
; Error bits: %7O
;>;
SYST12: JRST EOLRET
;READT MORET READT1
;SUBROUTINE TO READ SYSTEM TABLE WHOSE NAME IS IN A INTO AC'S 4-16.
;USED IN SYSTAT, ERRSTAT.
READT: SETZ B, ;NORMAL ENTRY: START AT BEGINNING OF TABLE
MORET: MOVE D,B ;ENTRY FOR TABLE INDEX IN B
CALL $SYSGT
JUMPN B,.+2
CALL SCREWUP ;NO SUCH TABLE
HLLZ C,B ;FORM AOBJN INDEX
SOJGE D,[AOBJP C,[RET] ;PASS UNWANTED ENTRIES
JRST .]
PUSH P,[D] ;INIT PTR TO AC'S TO STORE VALUES IN
READT1: HRR A,B ;TABLE #
HRL A,C ;INDEX
GETAB ;READ A WORD OF TABLE INTO A
CALL JERR
MOVEM A,@(P)
AOS A,(P)
CAIGE A,P ;STOP BEFORE OVERWRITING P!
AOBJN C,READT1 ;END-OF-TABLE TEST AND LOOP
SUB P,[1,,1]
RET
;.TRMST TRMST0 TRMST1 TRMST2 TRMST3 TRMST4 TRMST5 TRMST6 TRMS60 TRMS61 TRMS62 TRMS63 TRMS64 TRMST7 TRMST8 TRMST9 TRMS10 TRMS11 TRMS12 TRMS13 TRM131 TRM132 TRMS14 TRM141 TRM142 TRM143 TRM144 TRM145
;TERMINAL STATUS COMMAND "TRMSTAT"
.TRMST: SKIPN PTTYMD ;DOES PROGRAM HAVE A TERMINAL?
ERROR <Terminal status not yet defined>
TRMST0: MOVE 1,COJFN
RFMOD
MOVE 3,[7B3!177B10!177B17!3B27!3B31!3B33] ;STPAR BITS
AND 2,3 ;EXTRACT THESE
ANDCAM 3,PTTYMD+0 ;FLUSH FROM PTTYMD
IORM 2,PTTYMD+0 ;UPDATE
GTTYP
ETYPE < Terminal type: %2O>
PRINT EOL
TRMST1: MOVSI 1,(1B1)
TDNN 1,PTTYMD+0
TYPE < Lacks>
TDNE 1,PTTYMD+0
TYPE < Has>
TYPE < mechanical formfeed>
PRINT EOL
TRMST2: MOVSI 1,(1B2)
TDNN 1,PTTYMD+0
TYPE < Lacks>
TDNE 1,PTTYMD+0
TYPE < Has>
TYPE < mechanical tabs>
PRINT EOL
TRMST3: MOVSI 1,(1B3)
TDNN 1,PTTYMD+0
TYPE < Lacks>
TDNE 1,PTTYMD+0
TYPE < Has>
TYPE < lowercase>
PRINT EOL
TRMST4: LDB 2,[POINT 7,PTTYMD+0,10]
ETYPE < Page length is: %2Q.>
PRINT EOL
TRMST5: LDB 2,[POINT 7,PTTYMD+0,17]
ETYPE < Line width is: %2Q.>
PRINT EOL
TRMST6: TLZ Z,F1 ;COMMUNICATE WITH "BEFORE"
TYPE < Wake-up set: >
LDB 1,[POINT 2,PTTYMD+0,21]
CAIE 1,3
JRST TRMS60
CALL BEFORE
TYPE <All controls>
JRST TRMS62
TRMS60: MOVEI 1,1B20
TDNN 1,PTTYMD+0
JRST TRMS61
CALL BEFORE
TYPE <Formatting controls>
TRMS61: MOVEI 1,1B21
TDNN 1,PTTYMD+0
JRST TRMS62
CALL BEFORE
TYPE <Non-formatting controls>
TRMS62: MOVEI 1,1B22
TDNN 1,PTTYMD+0
JRST TRMS63
CALL BEFORE
TYPE <Punctuation>
TRMS63: MOVEI 1,1B23
TDNN 1,PTTYMD+0
JRST TRMS64
CALL BEFORE
TYPE <Alphanumerics>
TRMS64: PRINT EOL
TRMST7: LDB 2,[POINT 2,PTTYMD+0,25]
TYPE < Echo mode is: >
CAIN 2,0
TYPE <none>
CAIN 2,1
TYPE <immediate>
CAIN 2,2
TYPE <immediate or deferred>
CAIN 2,3
TYPE <immediate and deferred>
PRINT EOL
TRMST8: TYPE < Links are being >
MOVEI 1,1B26
TDNN 1,PTTYMD+0
TYPE <refused>
TDNE 1,PTTYMD+0
TYPE <accepted>
PRINT EOL
TRMST9: TYPE < Terminal data mode is: >
MOVEI 1,1B29
TDNE 1,PTTYMD+0
TYPE <ASCII>
TDNN 1,PTTYMD+0
TYPE <binary>
PRINT EOL
TRMS10: TYPE < Lowercase output is being >
MOVEI 1,1B30
TDNN 1,PTTYMD+0
TYPE <sent to terminal>
TDNE 1,PTTYMD+0
TYPE <indicated by %X>
PRINT EOL
TRMS11: TYPE < Lowercase input is being >
MOVEI 1,1B31
TDNN 1,PTTYMD+0
TYPE <sent directly>
TDNE 1,PTTYMD+0
TYPE <converted to uppercase>
PRINT EOL
TRMS12: LDB 2,[POINT 2,PTTYMD+0,33]
CAIN 2,0
TYPE < Full duplex>
CAIN 2,2
TYPE < Character half duplex>
CAIN 2,3
TYPE < Line half duplex>
CAIN 2,1
TYPE < Undefined duplexity>
PRINT EOL
TRMS13: TLZ Z,F1 ;INITIALIZE "BEFORE"
TYPE < Tab stops:>
MOVE 2,[POINT 1,PTTYMD+1]
MOVEI 3,0 ;COLUMN TO PRINT
MOVEI 4,↑D<3*36> ;HOW MANY TO TEST
TRM131: ILDB 1,2
JUMPE 1,TRM132 ;NO TAB IN THIS COLUMN
CALL BEFORE
ETYPE <%3Q>
TRM132: ADDI 3,1 ;BUMP COLUMN NUMBER
SOJG 4,TRM131
TRMS14: MOVEI 3,3 ;TYPE BEING SCANNED FOR, THIS PASS
TRM141: MOVE 4,[POINT 2,PTTYMD+4] ;INITIAL POINTER TO CCOC BYTES
MOVEI 5,100 ;CHARACTER TO PRINT
MOVEI 6,40 ;HOW MANY TO CHECK
TLZ Z,F1!F2 ;FOR "BEFORE" AND HEADING PRINTER
TRM142: ILDB 1,4 ;PICK UP CCOC BYTE
CAIE 1,0(3) ;SAME AS THAT BEING SCANNED FOR?
JRST TRM145 ;NO
TRM143: TLOE Z,F2 ;HAS HEADING BEEN OUTPUT?
JRST TRM144 ;YES
CAIN 3,0
TYPE <
Ignored controls:>
CAIN 3,1
TYPE <
Indicated controls:>
CAIN 3,2
TYPE <
Sent controls:>
CAIN 3,3
TYPE <
Simulated controls:>
TRM144: CALL BEFORE ;PRINT COMMA IF NEEDED
PRINT "↑"
PRINT 0(5)
TRM145: ADDI 5,1 ;MOVE TO NEXT CHARACTER
SOJG 6,TRM142 ;CONTINUE THIS SCAN
SOJGE 3,TRM141 ;MOVE TO NEXT TYPE
RET
;.FULLD .HALFD .FORMF .TABS TABS1 .SHOW .LOWER .RAISE CMOD .LLENG
;TERMINAL CHARACTERISTICS COMMANDS GROUP
; LOWERCASE, FORMFEED, TABS, NO LOWERCASE, NO FORMFEED, NO TABS,
; RAISE, NO RAISE, HALFDUPLEX, FULLDUPLEX, INDICATE.
;THESE COMMANDS CHANGE THE FILE MODE WORD AND THE CONTROL CHARACTER
;OUTPUT CONTROL (CCOC) WORDS FOR THE PRIMARY OUTPUT FILE,
;AND ALSO THE THREE SETS OF THESE VALUES KEPT IN STORAGE.
;THE "NO" PREFIXED VERSIONS GO THRU THE SAME ROUTINES AS THE UNPREFIXED
;VERSIONS, BUT WITH F1 SET WHICH REVERSES THE EFFECT OF THE SUBROUTINES
;THEY CALL. F1 IS CLEAR ON DISPATCH FROM THE MAIN LOOP.
.FULLD: TLC Z,F1 ;"FULLDUPLEX" = "NO HALFDUPLEX".
.HALFD: MOVEI C,3B33 ;"HALFDUPLEX". "HALF DUPLEX" MODE BIT.
JRST CMOD ;CHANGE FILE MODE WORD
.FORMF: HRLZI C,B1 ;"FORMFEED". "HAS MECH. FF" MODE BIT
MOVE D,[POINT 2,(E),25] ;POINTER TO ↑L CCOC BYTE
JRST TABS1
.TABS: HRLZI C,B2 ;"TABS". "HAS HARDWARE TABS" MODE BIT
MOVE D,[POINT 2,(E),19] ;PTR TO ↑I CCOC BYTE
TABS1: CALL CMOD ;CHANGE FILE MODE WORD
JRST CCCOC ;CHANGE CONT. CHAR. OUTPUT CONT. WORDS
;LOWERCASE: CONTROLS LOWER CASE OUTPUT.
;IT MAY ALSO BE NECESSARY TO CLEAR "INDICATE WITH %" BIT,
;BUT PREFERABLE NOT TO IF IT HAS NO EFFECT WHEN B3 ON.
.SHOW: NOISE (lower case with '%')
MOVEI C,1B30 ;INDICATE LOWER CASE
JRST CMOD
.LOWER: HRLZI C,B3 ;"LOWERCASE". "HAS LOWER CASE" MODE BIT.
JRST CMOD ;CHANGE FILE MODE WORD
;RAISE: CONTROLS CONVERSION OF LOWER CASE TO UPPER ON INPUT.
.RAISE: MOVEI C,1B31 ;"CONVERT LOWER CASE TO UPPER" MODE BIT
;CHANGE TELETYPE MODE WORD SUBR
;CHANGES MODE IN EFFECT
;TAKES: C: MASK INDICATING BITS TO CHANGE.
; AC Z LH BIT F1: ON TO CLEAR BIT(S), OFF TO SET THEM.
;PRESERVES D, DESTROYS A, B.
CMOD: MOVE A,COJFN ;OUTFILE IS MOST LIKELY TO BE TTY
RFMOD
ANDCAM C,B
TLNN Z,F1
IORM C,B
STPAR ;THESE ARE ALL TERMINAL PARAMETERS
RET
;LENGTH (OF PAGE IS) <DECIMAL NUMBER>
.LLENG: NOISE (of page is)
CALL DECIN
JRST CERR
ALLOW TSPC+TALT+TEOL
CONFIRM
CAIL A,5
CAILE A,↑D127
JRST CERR
MOVE C,A
MOVE 1,COJFN
RFMOD
DPB C,[POINT 7,2,10]
STPAR
RET
;.TERMI $TERMI TRMTAB .VT06 .VTCR .HYTYP .DMN .DM .TI733 .T33 .T35 .T37 .LA30 .NVT .TTY3 .SCOPE SCOPE1 SCOPE2 .BENDI .BEEHI .INFOT .DATA1 .VTS .TI .TI1
;TERMINAL TYPE IS
;NOTE: GET SOMEBODY AT BBN TO ASSIGN NEW (UNIQUE) TERMINAL NUMBERS
; IN THE MONITOR. THIS AVOIDS CONFUSION WITH OTHER SITES.
; LOCAL STTYP NUMBERS SHOULD BE NEGATIVE NUMBERS.
.TERMI: NOISE (type is)
KEYWD $TERMI
0
JRST CERR
JRST (KWV)
$TERMI: TABLE
TE 14,,.DMN
TE 15,,.DM
TE 33,,.T33
TE 35,,.T35
TE 37,,.T37
TE 4,,.VT06
TE 4023,,.DATA1
TE 5,,.VTCR
TE 6,,.HYTYP
TE AJ,,.TI
TE ANDERSON-JACOBSON,,.TI
TE BEEHIVE,,.BEEHI
TE BENDIX,,.BENDI
TE CDI,,.TI
TE COMPUTER-DEVICES,,.TI
TE DATA100,,.DATA1
TE DATAMEDIA,,.DM
TE DM,,.DM
TE EXECUPORT,,.TI
TE INFOTON,,.INFOT
TE LA30
TE LOGIPORT,,.BENDI
TE NCR,,.TI
TE NVT
TE SCOPE,,.SCOPE
TE TEKTRONIX-4023,,.DATA1
TE TERMINET,,.LA30
TE TI,,.TI
TE TI733
TE VTS
TEND
;TABLE OF TERMINAL PAGE LENGTHS AND LINE WIDTHS
;LENGTH IN LH, WIDTH IN RH
TRMTAB: ↑D66,,↑D72
↑D66,,↑D72
↑D66,,↑D72
↑D66,,↑D72
↑D25,,↑D72
↑D25,,↑D72
↑D66,,↑D127 ;FIELD IS ONLY 7 BITS WIDE
↑D66,,↑D72
↑D66,,↑D80
↑D66,,↑D72
↑D12,,↑D72
↑D66,,↑D72
↑D24,,↑D80
↑D24,,↑D80
.VT06: PUSH P,[↑D25]
PUSH P,[↑D72]
PUSH P,[4]
JRST SCOPE1
.VTCR: PUSH P,[↑D25]
PUSH P,[↑D72]
PUSH P,[5]
JRST SCOPE1
.HYTYP: PUSH P,[↑D66]
PUSH P,[↑D80]
PUSH P,[6]
JRST SCOPE1
.DMN: PUSH P,[↑D24]
PUSH P,[↑D80]
PUSH P,[14]
JRST SCOPE1
.DM: PUSH P,[↑D24]
PUSH P,[↑D80]
PUSH P,[15]
JRST SCOPE1
.TI733: MOVEI B,11
JRST .TTY3
.T33: TDZA B,B
.T35: MOVEI B,1
JRST .TTY3
.T37: SKIPA B,[2]
MOVEI B,3
JRST .TTY3
.LA30: SKIPA B,[10]
.NVT: MOVEI B,7 ;TERM TYPES 4, 5, AND 6 RESERVED
;SO IS 13
.TTY3: CONFIRM
MOVE A,COJFN
STTYP
CALL .RAISE ;IN ORDER TO RECOGNIZE ALTMODES
;DUPLEXITY IS DETERMINED ONLY BY "HALF" AND
;"FULL". NVT'S ARE HALF ONLY AS A DEFAULT
PUSH P,[↑D66] ;PAGE LENGTH
PUSH P,[↑D72] ;LINE WIDTH
JRST SCOPE2
;TERMINAL (TYPE IS) SCOPE (PAGE LENGTH) <DEC NUM> (PAGE WIDTH) <DEC NUM>
.SCOPE: ALLOW TSPC+TALT
NOISE (page length)
CALL DECIN
JRST CERR
ALLOW TSPC+TALT
CAIL A,5
CAILE A,↑D127
JRST CERR
PUSH P,A
NOISE (page width)
CALL DECIN
JRST CERR
ALLOW TSPC+TALT+TEOL
CAILE A,↑D127
JRST CERR
PUSH P,A
PUSH P,[12] ;?
SCOPE1: CONFIRM
TLO Z,F1 ;SAY "NO"
CALL .RAISE
TLZ Z,F1 ;DON'T MESS UP OTHER CALLERS
CALL .FORMF ;TURN OFF "INDICATE FORMFEED" STUFF
MOVE 1,COJFN
POP P,2 ;SCOPE TERMINAL TYPE
STTYP
SCOPE2: RFMOD
POP P,C
DPB C,[POINT 7,2,17] ;SET WIDTH
POP P,C
DPB C,[POINT 7,2,10] ;LENGTH
STPAR
RET
;TERMINAL (TYPE IS) BENDIX
.BENDI: PUSH P,[↑D16]
PUSH P,[↑D72]
PUSH P,[12]
JRST SCOPE1
;TERMINAL (TYPE IS) BEEHIVE
.BEEHI: PUSH P,[↑D20]
PUSH P,[↑D72]
PUSH P,[12]
JRST SCOPE1
;TERMINAL TYPE INFOTON
.INFOT: PUSH P,[↑D23]
PUSH P,[↑D72]
PUSH P,[12]
JRST SCOPE1
;TERMINAL TYPE DATA100
.DATA1: PUSH P,[↑D24]
PUSH P,[↑D72]
PUSH P,[12]
JRST SCOPE1
;TERMINAL TYPE VTS
.VTS: PUSH P,[↑D43]
PUSH P,[↑D72]
PUSH P,[12]
JRST SCOPE1
.TI: PUSH P,[.TI1]
PUSH P,[↑D66]
PUSH P,[↑D79]
PUSH P,[3]
JRST SCOPE1
.TI1: TLO Z,F1
MOVEI C,1B31 ;NO RAISE
CALL CMOD
CALL .FORMF ;NO FORMFEED (SIMULATE)
TLZ Z,F1+F2
MOVE D,[POINT 2,(E),17]
CALL CCCOC ;REAL BACKSPACE
RET
;.LWIDTH
;WIDTH OF TERMINAL LINE
.LWIDTH: NOISE (of line is)
CALL DECIN
JRST CERR
ALLOW TSPC+TALT+TEOL
CONFIRM
CAILE A,177 ;127. IS MAX
MOVEI A,177
MOVE C,A
MOVE A,COJFN
RFMOD
DPB C,[POINT 7,B,17]
STPAR
RET
;.INDIC .INDI1 CCCOC CCCOCS
;INDICATE (FORMFEED)
.INDIC: NOISE (formfeed)
CONFIRM
.INDI1: TLO Z,F2
MOVE D,[POINT 2,(E),25]
;SUBR TO CHANGE CCOC BYTE TO SIMULATE (IF F1 ON & F2 OFF)
; OR SEND (IF F1 AND F2 OFF) OR INDICATE (IF F2 ON).
;BYTE TO CHANGE IS INDICATED BY A BYTE PTR IN D, INDEXED BY E.
;DESTROYS A, B, C, E.
CCCOC: MOVE A,COJFN
RFCOC
MOVEI E,B
CALL CCCOCS ;OPERATE ON CCCOC WORDS IN B,C
MOVE A,COJFN
SFCOC ;PUT NEW VALUE INTO EFFECT
MOVEI E,ETTYMD+4 ;OPERATE ON STORED VALUES
CALL CCCOCS
MOVEI E,PTTYMD+4
;SUBSUBROUTINE TO OPERATE ON BYTE IN WORDS E POINTS TO
CCCOCS: MOVEI A,2 ;2 = SEND CODE
TLNE Z,F1
MOVEI A,3 ;3 = SIMULATE
TLNE Z,F2
MOVEI A,1 ;1 = INDICATE BY ↑X
DPB A,D
RET
;.ACCES ACCES1 ACCES2 ACCE21 ACCES3 ACCES4 ACCE.T $ACCS1 $ACCS2
SUBTTL PDP-10 TENEX EXECUTIVE COMMANDS ROUTINES ** X1CMD.MAC **
;ROUTINES TO DECODE AND EXECUTE SPECIFIC COMMANDS.
;DISPATCHED TO BY EXEC COMMAND INTERPRETER MAIN FILE (XMAIN.MAC).
;IN ALPHABETICAL ORDER BY COMMAND NAME.
;"ACCESS (TO FILES) <LIST> (BY) SELF,GROUP,OTHERS (IS) READ,WRITE,
; EXECUTE,APPEND,PAGE-TABLE,UNUSED,ALL,NONE"
.ACCES: NOISE <to files>
CALL .INFG ;INPUT FILES LIST
ALLOW TLPR!TALT!TSPC
NOISE (by)
PUSH P,[0] ;TEMP
ACCES1: TLO Z,NEOLF ;SAY DON'T ECHO EOLS
KEYWD $ACCS1
T OTHERS,COMOK!NSPALT,000077 ;DEFAULT
JRST CERR
ANDI KWV,-1 ;FLUSH FLAGS
IORM KWV,0(P) ;VALUE IS MASK
ALLOW TCOM!TALT!TSPC
TRNE CBT,TCOM ;SEPARATOR WAS COMMA?
JRST ACCES1 ;COMMA, GET NEXT WORD
ACCES2: ALTYPE ( )
NOISE <is>
PUSH P,[0] ;TEMP
ACCE21: TLO Z,NEOLF
KEYWD $ACCS2
T NORMAL,COMOK!EOLOK,52
JRST CERR
ANDI KWV,-1 ;FLUSH FLAGS
CAIE KWV,0 ;"NONE"
CAIN KWV,52 ;"NORMAL"
SETZM 0(P) ;CLEAR WHAT WAS SAID BEFORE
IORM KWV,0(P) ;ACCUMULATE
CALL SPRTR ;ANALYZE TERMINATOR
JRST ACCE21 ;ANOTHER FIELD, PROCESS IT
JRST ACCE21 ;COMMA, PROCESS NEXT FIELD
CONFIRM ;EOL, GO
ACCES3: POP P,E
IMULI E,010101
POP P,F ;MASK
MOVEI A,ACCE.T
MOVEM A,ILIDSP ;SET TO CATCH BAD CHFDB
CALL FRSTF ;TYPE FIRST FILE NAME
ACCES4: HRRZ 1,@INIFH1 ;GET JFN
DVCHR
TLNN 2,(1B4) ;DISK?
JRST [ ETYPE < %1H: does not have protected files
>
JRST NEXTF] ;GET NEXT FILE, GO TO ACCES4
MOVSI 1,FDBPRT ;PROTECTION WORD
HRR 1,@INIFH1 ;FORM INDEX,,JFN
HRRZ 2,F ;ACCESS PATHS
HRRZ 3,E ;PROTECTION
TRNE 2,20000 ;TRYING TO CHANGE THIS BIT TO 0?
TROE 3,20000
CAIA
TYPE < 20000 bit forced on
>
HRLI 3,(5B2) ;MAKE IT NUMERIC
CHFDB
JRST NEXTF ;GET NEXT FILE, RETURN TO ACCES4
;CHFDB WILL TRAP TO HERE
ACCE.T: SETZM ILIDSP ;CANCEL THE TRAPPER
ERROR <Access violation>
$ACCS1: TABLE
T ALL,COMOK,777777
T GROUP,COMOK,007700
T OTHERS,COMOK,000077
T SELF,COMOK,770000
TEND
$ACCS2: TABLE
T ALL,COMOK!EOLOK,77
T APPEND,COMOK!EOLOK,04
T EXECUTE,COMOK!EOLOK,10
T NONE,COMOK!EOLOK,00
T NORMAL,COMOK!EOLOK,52
T PAGE-TABLE,COMOK!EOLOK,02
T READ,COMOK!EOLOK,40
T UNUSED,COMOK!EOLOK!INVIS,01
T WRITE,COMOK!EOLOK,20
TEND
;.ACCOU ACCOU0 ACCOU1 ACCOU2 ACCOU3
;ACCOUNT (OF FILE) <NAME> (IS) <ACCOUNT # OR STRING>
REPEAT 0,<
.ACCOU: NOISE <of files>
CALL .INFG ;INPUT FILE GROUP
REPEAT 0,< ;SEE IF TARGET DIRECTORY SPECIFIES STRING OR NUMBER
ACCOU0: MOVE A,CSBUFP
MOVE B,CJFN1
HRLZI C,B5 ;DIRECTORY NAME ONLY, UNPUNCTUATED.
JFNS ;GET STRING FOR DIRECTORY NAME>
REPEAT 1,< ;SEE IF USER SPECIFIES STRING OR NUMERIC ACCT
ACCOU1: GJINF
MOVE B,A ;USER'S LOGIN DIRECTORY
MOVE A,CSBUFP
DIRST
CALL SCREWUP>
ACCOU2: MOVEI A,1
MOVE B,CSBUFP
STDIR ;CONVERT BACK TO GET LEFT HALF BITS
JRST CERR
JRST CERR
ALLOW TSPC!TALT!TLPR!TEOL
NOISE <is>
CALL ACCT ;GET ACCOUNT NUMBER OR STRING, USING A.
MOVE E,A ;SAVE THRU DVCHR'S
CONFIRM
CALL FRSTF ;PRINT NAME OF FIRST FILE IN GROUP
ACCOU3: HRRZ 1,@INIFH1 ;GET THE JFN
DVCHR
HLRZS 1
CAIE 1,600000 ;DEVICE IS DSK: ?
JRST [ UTYPE [ASCIZ / not a disk file/]
JRST NEXTF] ;DO NEXT, RETURN TO ACCOU3
HRRZ 1,@INIFH1 ;JFN
MOVE 2,E ;ACCOUNT
SACTF ;SET ACCOUNT OF FILE
CALL [ CAIN 1,SACTX4
UERR [ASCIZ /No access to change account of that file/]
JRST SCREWUP]
JRST NEXTF ;GNJFN, TYPE NAME, GO TO ACCOU3
>;REPEAT 0
;APPEND" IS WITH "COPY" IN X2CMD.MAC.
;.ADVIS
;ADVISE (USER) <USERNAME OR TERMINAL NUMBER>
REPEAT 0,<
.ADVIS: NOISE (user)
CALL TTYNUM
MOVEI 1,400000(1) ;FORM TTY DESIGNATOR
TLO 1,(1B1) ;SET "ADVISE TO" FLAG
ADVIZ
CALL [ CAIN 1,ADVX4
ERROR <Only one advise link is permitted>
CAIN 1,ADVX2
ERROR <ingored>
CAIN 1,ADVX1
ERROR <refused>
JRST JERR]
RET
>
;.ASSIG
;ASSIGN <DEVICE> (AS) <LOGICALNAME>
.ASSIG: NOISE (device)
CALL DEVN ;READ DEVICE NAME, CHECK IT.
;ACCEPTS USUAL TERMINATORS, PLUS COLON
PUSH P,A ;...RETURNS DEV DESGNATOR IN A,
PUSH P,B ;...CHARACTERISTICS IN B,
;...JOB # ASS TO IN C.
TLNN B,B3
ERROR <%1H: cannot be assigned>
TLNN B,B5 ;"AVAILABLE" BIT
JRST [ TLNN B,B6 ;NOT AVAIL, ASSIGNED?
UERR [ASCIZ /%1H: not available/] ;%H: DEV NAME
UERR [ASCIZ /%1H: already assigned to job %3Q/]]
TLNE B,B6
$TYPE < [Already assigned to you] >; ADVISORY MSG, NOT ERROR
LDB C,[POINT 9,A,17]
CAIN C,12 ;DEVICE TYPE TTY?
JRST [ MOVEI E,(A) ;MASK TTY #
GJINF ;JOB'S CONT TTY # TO D
CAMN D,E
UERR [ASCIZ /You can't assign your controlling terminal/]
;DVCHR B5 & B6 CLEAR FOR TTY THAT IS ANOTHER JOB'S
; CONTROLLING TTY. 11/25/70.
MOVE A,['TTYJOB']
CALL $SYSGT ;GET # OF TABLE OF TTYS
HRR A,B ;TABLE #
HRL A,E ;TTY # IS TABLE INDEX
GETAB ;GET TABLE WORD
CALL JERR
HLRZ C,A
MOVE A,-1(P) ;DEV DESIG FOR ERROR MESSAGES
CAIN C,-1
JRST .+1 ;TTY IS FREE IF -1 IN LH TBL WD
JUMPG C,[UERR [ASCIZ /%1H: is the controlling terminal for job %3Q/]]
;POSITIVE: JOB #
UERR [ASCIZ /%1H: busy/]] ;-2: BEING ASSIGNED
;B0+JOB # ASSIGNED TO ALSO GETS THIS
;IF FOR SOME REASON ABOVE CHECKS FAIL.
SETZ B, ;INDICATES NO SYNONYM
TRNE CBT,TEOL
JRST ASSIG3 ;CR, NO SYNONYM FIELD
NOISE <as>
;ASSIG3 ASSIG5
;ASSIGN...
;NEXT FIELD, IF NOT NULL, IS LOGICAL NAME (SYNONYM).
TLO Z,PUNCF
CALL CSTR
CAIG CNT,1
JRST [ TLO Z,BAKFF ;NULL, NO LOG NAME. B 0.
JRST ASSIG3]
;MAKE SURE THE STRING IS NOT ALREADY A SYNONYM
;(ACCEPT PHYSICAL DEVICE NAMES).
CALL BUFFF ;OR IS .BFP OK?
MOVE B,A
CAIN TRM,ALTM
CALL UBP
ALTYPE <:>
ERROR <Synonyms not implemented yet>; ←←←←←←← 8/28/70
ASSIG3: CONFIRM
POP P,A ;DEVICE CHARACTERISTICS
TLNN A,B7 ;"MOUNTABLE" BIT
JRST ASSIG5 ;NOT MOUNTABLE
MOVE A,(P) ;DEVICE DESIGNATOR
;TLO A,B3 ;SAY DON'T READ DIRECTORY
MOUNT ;MIGHT BE NEEDED TO INVALIDATE DIR IN CORE ←←←←
CALL JERR
ASSIG5: MOVE A,(P) ;DEVICE DESIGNATOR
ASND
CALL JERR
POP P,A ;DEVICE DESIG AGAIN
JUMPE B,.+3 ;B CONTAINS 0 OR LOGICAL NAME PTR
CSYNO
CALL JERR
JRST CMDIN4
;.ATTAC
;ATTACH (USER) <NAME> (PASSWORD) -- (TSS JOB #) <#>
;LIKE LOGIN, THIS COMMAND ALSO ACCEPTS THE FORM:
;ATTACH
;(USER) <NAME>
;(PASSWORD) ----
;(TSS JOB #) <#>
;PASSWORD IS NOT ECHOED IN FULL DUPLEX, TYPED OVER MASK ON
;FOLLOWING LINE IN HALF DUPLEX.
;TSS JOB # CAN BE OMITTED IF THERE IS ONLY ONE JOB FOR GIVEN USER.
;IF NOT LOGGED IN, CURRENT JOB GOES AWAY (HANDLED BY MONITOR),
;IF LOGGED IN IT IS DETACHED.
.ATTAC: CALL SPECEOL ;SPECIAL HANDLING OF EOL TERMINATOR FOR
;OPTIONAL FANCY FORMAT.
NOISE <user>
CALL USERN ;INPUT USER (DIRECTORY) NAME
TLNE A,B0
ERROR <That's a files-only directory name>
MOVEI A,(A) ;MASK DIR #
PUSH P,A ;SAVE DIR #
CALL SPECEOL ;CHECK TERMINATOR & HANDLE EOL SPECIALLY
HRRZ A,0(P) ;DIRNUM
CALL PASWD ;INPUT AND CHECK PASSWORD (USES A)
PUSH P,A ;SAVE PASSWORD STRING POINTER
NOISE <Tenex job #>
INHELP <
Number if you have more than one job>
ALLOW TALT+TSPC+TEOL
CAIN CNT,2
JRST [ MOVE B,.BFP
ILDB B,B
CAIN B,"-"
JRST ATTAC5 ;NULL INDICATED WITH "-"
JRST .+1]
TLO Z,BAKFF
CALL DECIN
JRST [ UALTYP [ASCIZ /-/] ;NULL. TYPE "-" ON ALT MODE.
JRST ATTAC5]
PUSH P,A ;SAVE JOB # INPUT BY USER
;ATAC4B
;ATTACH...
;CHECK THAT USER-GIVEN JOB # IS IN LEGAL RANGE
SETO D,
GTB 3 ;GET MAX JOB # AS LENGTH OF SYSTEM TABLE 3
MOVN A,A ;LENGTH COMES BACK NEGATIVE
SUBI A,1 ;SO VALUE COMES OUT RIGHT IN ERR MSG
CAML A,(P) ;LENGTH MUST BE > GIVEN #
SKIPGE D,(P) ;GIVEN JOB # TO D
ERROR <Tenex job # must be between 0 and %1Q>
;MAKE SURE GIVEN JOB # IS LOGGED IN W MATCHING DIR # AND IS ATTACHED
GTB 1 ;ENTRY NEG IF NO SUCH JOB
JUMPL A,[UERR[ASCIZ/No job %4Q/]]
GTB 0 ;LINE # OR NEGATIVE FOR DETACHED IN LH
JUMPL A,ATAC4B
HLRZ A,A ;TTY #
ETYPE < [Attached to TTY%1O]>
TLO KWV1,CONMAN ;REQUIRE CONFIRMATION IN THIS CASE
ATAC4B: GTB 3 ;LOGIN DIR NO IN RH
MOVEI A,(A) ;MASK DIR NO UNDER WH THIS JOB IS LOGGED IN
JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]]
MOVE E,-2(P) ;DESIRED DIRECTORY #, FOR USE IN ERR MSG
CAME A,E
ERROR <Job %4Q not logged in under %5R>
JRST ATTAC7 ;GO CONFIRM AND EXECUTE
;ATTAC5 ATA5A ATA5B ATA5C
;ATTACH...
;NO JOB # GIVEN, SEE IF THERE IS A UNIQUE ONE FOR GIVEN NAME.
ATTAC5: ;SEARCH SYSTEM TABLE 3 FOR A MATCH
MOVE E,-1(P) ;DIR # TO SEARCH FOR (USED IN ERR MSGS!)
SETO D,
GTB 3 ;SYSTEM TABLE 3: BY JOB #, LOGIN DIR # IN RH.
HRLZ D,A ;SET UP LENGTH,,INDEX FOR AOBJN & GTB.
ATA5A: GTB 3
MOVEI A,(A) ;MASK THIS JOB'S LOGIN DIR #
CAME A,E
ATA5B: JRST [ AOBJN D,ATA5A ;LOOP ENDTEST
UERR [ASCIZ /No detached job logged in under %5R/]]
GTB 0
JUMPGE A,ATA5B ;IGNORE NON-DETACHED JOBS
;FOUND ONE, SEE IF ITS THE ONLY ONE.
MOVEI B,(D)
PUSH P,B ;SAVE JOB # OF JOB FOUND
ATA5C: AOBJP D,ATTAC7 ;IF END OF TABLE, GO CONFIRM AND EXECUTE
GTB 3
MOVEI A,(A)
CAME A,E
JRST ATA5C
GTB 0
JUMPGE A,ATA5C ;IGNORE NON-DETACHED JOBS
ERROR <Tenex job # required - %5R has more than one detached job>
;ATTAC7
;ATTACH...
ATTAC7: CONFIRM
;EXECUTE THE COMMAND
;IF LOGGED IN, TYPE JOB # OF THIS JOB
GJINF
JUMPLE A,.+2
ETYPE < Detaching job # %3Q
>
;ATTACH
POP P,A ;TSS JOB # TO ATTACH TO
POP P,C ;PASSWORD STRING POINTER
POP P,B ;RH: DIR # TO ATTACH TO
;B0 OFF SAYS DON'T STOP IT
ATACH
CALL [ CAIN A,ATACX4
UERR [ASCIZ /Incorrect password/]
;NOTE THAT BAD PASSWORD IS DETECTED ABOVE
;IF NOT LOGGED IN
JRST JERR]
;THIS JOB CONTINUES RUNNING IF LOGGED IN.
GJINF ;GET TSS JOB # IN A
JUMPG A,CMDIN4 ;LOGGED IN, GO GET NEXT COMMAND
;NOT LOGGED IN, ATACH FAILED TO KILL JOB, DO SO IN EXEC.
SETO A, ;SAY SELF
LGOUT ;KILL JOB
CALL JERR ;LGOUT FAILED
;.AVAIL $AVAIL ..TERM TERMI1 TERMI9 EOLRET .PTYS .PTY1 .PTY2 .PTY3 .NVTS TERMY1 TERMY9
;AVAILABLE [LINES/DEVICES]
.AVAIL: KEYWD $AVAIL
T LINES,EOLOK,..TERM
JRST CERR
;CAN'T CONFIRM HERE BECAUSE OF FUDGE-ENTRIES IN TABLE
JRST (KWV)
$AVAIL: TABLE
T DEVICES,EOLOK
T LINES,EOLOK,..TERM
T NVTS,EOLOK
T PTYS,EOLOK
T T,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /ERMINALS /]
JRST ..TERM]> ;"T" = "TERMINALS"
T TE,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /RMINALS /]
JRST ..TERM]>
T TELETYPES,EOLOK+INVIS,..TERM
T TERMINALS,EOLOK+INVIS,..TERM
T TTYS,EOLOK+INVIS,..TERM
T VTYS,EOLOK+INVIS,.PTYS
TEND
;AVAILABLE TERMINALS
..TERM: CONFIRM
SETO D, ;WORD -1 OF A TABLE IS ALWAYS LENGTH
GTB 4 ;SYSTEM TABLE 4 IS LINE STATUSES
HRLZ D,A ;D IS AOBJN COUNT,,LINE #
;TLZ Z,F1 ;CLEAR TO SAY NOTHING PRINTED YET
TERMI1: GTB 4 ;LINE # = TABLE INDEX. GET A LINE'S STATUS.
HLRZ A,A ;LEFT HALF OF TABLE WORD
CAIE A,-1 ;IS -1 FOR FREE LINES
JRST TERMI9
CALL BEFORE ;TYPE COMMA OR MAYBE EOL
;TYPE <Line >; ;DESIREABLE?
HRRZ B,D
CALL TOCT ;TYPE LINE NUMBER
TERMI9: AOBJN D,TERMI1
TLNN Z,F1
TYPE < All lines in use>
EOLRET: PRINT EOL ;COME HERE TO TYPE CRLF AND POPJ.
RET
.PTYS: CONFIRM
MOVE A,[SIXBIT /PTY/]
SYSGT
MOVE D,A
SKIPN B
ERROR <No PTY table>
.PTY1: GTB 4
HLRZ A,A
CAIE A,-1
JRST .PTY2
CALL BEFORE
HRRZ B,D
CALL TOCT
.PTY2: AOBJN D,.PTY1
.PTY3: TLNN Z,F1
TYPE < All lines in use>
JRST EOLRET
.NVTS: CONFIRM
SETO D, ;WORD -1 OF A TABLE IS ALWAYS LENGTH
GTB 4 ;SYSTEM TABLE 4 IS LINE STATUSES
HRLZ D,A ;D IS AOBJN COUNT,,LINE #
ADD D,[11,,11] ;SKIP OVER REAL TTYS
MOVE A,[SIXBIT /PTY/]
SYSGT
SKIPN B
ERROR <No PTY table>
HLRE A,A
MOVN A,A
HRL A,A
ADD D,A ;SKIP OVER PTYS
;TLZ Z,F1 ;CLEAR TO SAY NOTHING PRINTED YET
TERMY1: GTB 4 ;LINE # = TABLE INDEX, GET A LINE'S STATUS.
HLRZ A,A ;LEFT HALF OF TABLE WORD
CAIE A,-1 ;IS -1 FOR FREE LINES
JRST TERMY9
CALL BEFORE ;TYPE COMMA OR MAYBE EOL
;TYPE <Line >; ;DESIRABLE?
HRRZ B,D
CALL TOCT ;TYPE LINE NUMBER
TERMY9: AOBJN D,TERMY1
TLNN Z,F1
TYPE < All line in use>
JRST EOLRET
;.DEVIC BEFORE
;AVAILABLE DEVICES
;DOES NOT LIST TTYS OR ANY NON-ASSIGNABLE DEVICES
;THIS LEAVES DTAS, MTAS, PTP, PTR, AND ANY OTHER DEVICES ADDED LATER.
;ALSO LISTS SEPARATELY DEVICES ALREADY ASSIGNED TO THIS JOB.
.DEVIC: CONFIRM
;TLZ Z,F1 ;SAY NOTHING TYPED YET
;"DEVLUP" EXECUTES THE NEXT LOC FOR EACH DEVICE, WITH
CALL DEVLUP ;...NAME IN A, DVCHR WORD IN B.
CALL [ JUMPGE C,[RET] ;DONE IF ASSIGNED WITH ASND.
TLNN B,B3 ;DONE IF NOT ASSIGNABLE
RET
LDB B,[POINT 9,B,17] ;EXTRACT DEVICE TYPE
CAIN B,12 ;EXCLUDE TTYS ALSO
RET
CALL BEFORE ;SEPARATING CHARACTER(S)
JRST SIXPRT] ;PRINT SIXBIT NAME
TLNE Z,F1
PRINT EOL
JRST ASTTJ ;LIST DEVS ASSIGNED TO THIS JOB. WITH FILSTAT.
;SUBROUTINE FOR FORMATTING A LIST OF ITEMS SEVERAL TO A LINE.
;USED FOR AVAILABLE TERMINALS, AVAILABLE DEVICES, AND FILSTAT.
;BEFORE EACH ITEM: COMMA EXCEPT CRLF IF TOO FAR TO RIGHT.
BEFORE: PUSH P,A
PUSH P,B
MOVE A,COJFN
RFPOS
MOVEI B,(B) ;MASK COLUMN POSITION
CAIL B,↑D65
JRST [ PRINT EOL
JRST .+3]
TLOE Z,F1 ;SUPPRESS COMMA BEFORE FIRST ONE
PRINT ","
PRINT " " ;SPACE AFTER COMMA OR EOL
JRST [ POP P,B
POP P,A
RET]
;DEVLUP DEVL1 SIXPRT SIXPR1
;SUBROUTINE TO LOOP OVER ALL DEVICES FOR "AVAIL DEVICES" AND "FILSTAT".
;FOR EACH DEVICE, EXECUTES LOCATION AFTER CALL WITH SIXBIT NAME IN A
; DEVICE CHARACTERISTICS WORD (A LA "DVCHR" EXCEPT B5) IN B,
; -1 OR JOB # ASSIGNED TO IN C.
;RETURNS +2.
;DESTROYS A, B, C, D.
DEVLUP: SETO D,
GTB 6 ;GET # DEVICES FROM TABLE 6
HRLZ D,A ;AOBJN COUNT,,ABLE INDEX
DEVL1: GTB 7 ;GET DEVICE CHARACTERISTICS WORD FROM TABLE 7
MOVE B,A
GTB 10 ;GET JOB # ASS TO, OR -1, FROM LH TABLE 8
HLRE C,A
GTB 6 ;GET DEVICE NAME IN SIXBIT FROM TABLE 6
PUSH P,D
XCT @-1(P)
POP P,D
AOBJN D,DEVL1
JRST [ AOS (P)
RET]
;TYPE SIXBIT SYMBOL FROM A.
;USED IN "AVAILABLE DEVICES", "SYSTAT", "STATISTICS", AND "FILSTAT".
SIXPRT: PUSH P,B
PUSH P,C
MOVE C,A
SIXPR1: SETZ B,
LSHC B,6
ADDI B,40
CALL CCHRO
JUMPN C,SIXPR1
JRST [ POP P,C
POP P,B
RET]
;.BREAK BREAK1 BREAK3
;BREAK (LINKS)
.BREAK: NOISE <links>
BREAK1: CONFIRM
INTOFF
HRLOI 1,(1B0+1B1) ;BREAK TO AND FROM CONTROLLING
JRST BREAK3
;;BREAK2 IS CALL BY ↑ECREATE AND ↑EPRINT
;
;BREAK2: INTOFF ;BE SURE TO DO BOTH TLINK AND ADVIZ
; HRLOI 1,(1B0+1B1+1B4) ;BREAK TO AND FROM CONTROLLING
BREAK3: MOVEI 2,-1 ;ALL REMOTES, AND "REFUSE"
TLINK
CALL JERR
; MOVSI A,(1B0) ;BREAK ADVISE LINKS
; ADVIZ
; CALL JERR
INTON
RET
;.CHANG $CHANG C.PSWD C.PSW0 C.PSW1 C.PSWT
;"CHANGE" COMMAND
.CHANG: KEYWD $CHANG
0
JRST CERR
JRST 0(KWV)
$CHANG: TABLE
; T ACCOUNT,,C.ACCT
T PASSWORD,,C.PSWD
TEND
;;"CHANGE ACCOUNT (TO) ..."
;
;C.ACCT:
;;DETERMINE WHETHER LOGGED IN USER TAKES STRING OR NUMERIC ACCT
;..ACNT: GJINF ;LOGIN DIR # TO A
; MOVE B,A
; MOVE A,CSBUFP ;STRING BUFFER PTR
; DIRST ;CONVERT DIR # TO STRING
; CALL SCREWUP
; MOVEI A,1
; MOVE B,CSBUFP
; STDIR ;CONVERT BACK TO # PLUS BITS
; CALL SCREWUP
; CALL SCREWUP
;;NOW B1 OF A ON FOR STRING ACCT. FINISH INPUTTING COMMAND.
; TLNN A,B1 ;NOISE DEPENDS ON WHETHER USER TAKES...
; NOISE <# to> ;NUMERIC ACCOUNT,
; TLNE A,B1
; NOISE <to> ;OR STRING.
; CALL ACCT ;INPUT, CHK, CNVT ACCT INTO A (USES A )
; CONFIRM
; CALL PIE.P ;SKIP IF PIESLICE SYSTEM
; JRST C.ACC2
; PUSH P,A ;SAVE NEW ACCOUNT
; ADD P,[10,,10] ;NO CHECK FOR POV ←←←←←
; MOVEI A,-7+0(P) ;WHERE TO PUT STRING ACCT
; SETO B, ;SAY THIS JOB
; GACTJ ;GET CURRENT ACCOUNT
; CALL JERR
; ETYPE < Time used on account %1M: %B in %C>
; SUB P,[10,,10]
; POP P,A ;NEW ACCOUNT
; JRST C.ACC3
;
;C.ACC2: ETYPE < Time used on previous account: %B in %C>
;
;C.ACC3: SETZ B, ;NO SPECIAL FUNCTION BITS
; CACCT ;JSYS TO CHANGE ACCOUNT #
; CALL JERR
; RET
;
;"CHANGE PASSWORD (OF DIRECTORY) ... (FROM PASSWORD) ... (PASSWORD) ... (PASSWORD) ... "
C.PSWD:; CALL BREAK2 ;DO "BREAK" AND "REFUSE"
CALL SPECEOL ;MAKE EOL FORCE NOISE
NOISE <of directory>
CALL DIRNAM ;INPUT AND CHECK DIRECTORY NAME
PUSH P,A ;BITS,,# FROM STDIR
PUSH P,B ;POINTER TO BUFFERED NAME STRING
ALLOW TSPC+TALT+TEOL
ALTYPE ( )
CALL SPECEOL
ANDI A,-1 ;KEEP ONLY DIR NUM
MOVNS A ;SPECIAL NOISE & CHECK IT
CALL PASWD ;INPUT AND CHECK PASSWORD
PUSH P,A ;SAVE POINTER TO IT
ALLOW TSPC+TALT
SETZ A, ;SAY DON'T CHECK PASSWORD
CALL PASWD ;INPUT NEW PASSWORD
PUSH P,[0] ;CRDIR BLOCK BEGINS HERE
PUSH P,A ;SAVE POINTER TO IT
ALLOW TSPC+TALT
SETZ A, ;SAY DON'T CHECK PASSWORD
CALL PASWD ;INPUT NEW PASSWORD AGAIN
MOVE C,0(P) ;GET POINTER TO FIRST NEW PASSWORD
C.PSW0: ILDB B,A ;GET CHARACTER FROM SECOND NEW PASSWORD
ILDB D,C ;GET CHARACTER FROM FIRST NEW PASSWORD
CAME B,D ;ARE THEY THE SAME?
JRST CERR ;NO - USER MADE A TYPO
JUMPN B,C.PSW0 ;YES - CHECK THE NEXT LETTER
MOVE A,0(P) ;PASSWORDS MATCH - GET ORIGINAL STRING POINTER
IBP A ;BECAUSE WE'VE ALREADY GOTTEN AT LEAST ONE CHARACTER
CAMN A,C ;BETTER NOT BE A NULL PASSWORD
JRST CERR ;WILL BE HARD TO LOG IN IF PASSWORD IS NULL
ALLOW TALT+TSPC+TEOL
CONFIRM
C.PSW1: MOVEI A,C.PSWT
MOVEM A,ILIDSP ;SET TRAP RETURN FOR CRDIR
MOVE 1,-3(P) ;POINTER TO OLD NAME
MOVSI 2,(1B1) ;"SET PASSWORD" BIT
HRRI 2,-1(P) ;PARAMETER BLOCK LOCATION (PARTIAL)
MOVE 4,-2(P) ;NEW PASSWORD
CRDIR
CALL JERR
SETZM ILIDSP ;CANCEL ILLEGAL INSTR TRAP
SUB P,[5,,5] ;FLUSH JUNK
RET
;CRDIR TRAPS TO HERE
C.PSWT: SETZM ILIDSP ;DISABLE TRAPPER
CAIN 1,CRDIX1
ERROR <Ownership rights required>
JRST ILIPSI
;.CLEAR
;CLEAR (DIRECTORY OF DEVICE) <DEVICE NAME>
;FORCED CONFIRMATION
.CLEAR: NOISE <directory of device>
CALL DEVN
LDB D,[POINT 9,A,17] ;DEVICE TYPE
CAIE D,3
ERROR <DECtapes only>
TLNN B,B5 ;AVAILABLE?
JRST [ TLNN B,B6 ;ASSIGNED?
UERR [ASCIZ /%1H: not available/]
UERR [ASCIZ /%1H: assigned to job %3O/]]
TLNN B,B8
ERROR <%1H: not mounted>
CONFIRM
INIDR ;INITILIZE DIRECTORY (DESIGNATOR IN A)
CALL JERR
RET
;.CLOSE .COMMA .CONNE CONNE4
;CLOSE (FILE) <OPEN FILE NAME>
.CLOSE: NOISE <file>
JRST NIYE ;←←←←←←←←←←←←←←←←←←←←←←←←←
;COMMANDS (FROM FILE) <FILE NAME>
.COMMA: NOISE <from file>
JRST NIYE ;←←←←←←←←←←←←←←←←←←←←←←←←←
;CONNECT (TO DIRECTORY) <NAME> (PASSWORD) --
;(IF A WAY IS PROVIDED TO FIND OUT WHETHER A GIVEN DIRECTORY
; REQUIES A PASSWORD, MAKE IT REQUEST PASWD ON NEXT LINE (LIKE LOGIN)
; INSTEAD OF ASSUMING NULL IF NAME IS TERMINATED WITH CR BUT THIS
; DIRECTORY REQUIRES A PASSWORD).
.CONNE: NOISE <to directory>
CALL DIRNAM ;INPUT & CHECK DIRECTORY NAME
PUSH P,A ;DIR # ETC AS RETURNED BY "STDIR"
ALTYPE ( )
ALLOW TSPC+TALT+TEOL
;PASSWORD IS SECOND, OPTIONAL ARGUMENT
HRROI A,[ASCIZ //] ;USE NULL IF OMITTED
TRNE CBT,TEOL
JRST CONNE4
HRRZ A,0(P) ;DIR NUM
SKIPN LOCAL ;IS THIS A LOCAL TERMINAL?
CALL PASWD ;NO - INPUT & CHECK PASSWORD
CONNE4: ALLOW TALT+TSPC+TEOL
CONFIRM
PUSH P,A ;SAVE TEXT PTR TO PASSWD
CALL CHKDAL ;CHECK CURRENT DIRECTORY BEFORE LEAVING
POP P,B
HRRZ A,(P) ;DIRECTORY #
CNDIR
CALL [ CAIN A,CNDIX1
UERR [ASCIZ /Incorrect password/]
JRST JERR]
CALL CHKDAL ;CHECK NEW DIRECTORY
JRST CMDIN4
;$CONTI .CONTI ..CONT
;CONTINUE
;RESUMES FROZEN INFERIOR FORKS
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH
$CONTI: SKIPGE FORK ;HANDLE OF AN INFERIOR FORK
ERROR <No program>; ;NO INFERIORS AT ALL
;"FORK" SAYS WHETHER A FORK EXISTS, AND SAYS WHICH FORK "START" AND
;"REENTER" USE, BUT SINCE IT CAN BE CHANGED WITH "FORK" COMMAND
;IT MAY NOT BE THE RIGHT ONE TO CONTINUE.
SKIPGE A,LRFORK ;HANDLE OF LAST RUN INFERIOR, IF ANY.
ERROR <Program hasn't been run>; NO FORK RUN SINCE RESET.
RFSTS ;GET ITS STATUS (HANDLE IN A)
TLNE A,077700 ;DISTINGUISH -1 FROM 0-5,400000-400005
ERROR <Program disappeared>; ;-1 = UNASSIGNED HANDLE.
; JUMPGE A,[UERR [ASCIZ /Not interrupted/]] ;B0 MEANS FROZEN
RET
;"CONTINUE" COMMAND DISPATCHES HERE
.CONTI: CALL $CONTI
CONFIRM
;"REDIRECT/DETACH ... (AND) CONTINUE" JOINS HERE
..CONT: SETOM A
CALL MAPPF ;UNMAP ANY PAGE OF USER
MOVEI E,PTTYMD
CALL LTTYMD ;LOAD USER'S TTY MODE
TLO Z,RUNF ;SAY SO.
MOVE A,LRFORK ;FORK WHICH RAN LAST
RFSTS ;FIND OUT WHY IT STOPPED
HLRZ 3,1
TRZ 3,1B18 ;FLUSH FROZEN BIT
MOVE 1,LRFORK
CAIE 3,2 ;FORK WAS HALTED OR FORCE TERM?
CAIN 3,3
SFORK ;YES. START IT
JRST WAIT ;GO RESUME FORK AND WAIT FOR IT
;"COPY" IS IN X2CMD.MAC.
;.DAYTI .DAYT1 .DAYT3 .DAYT5 .DAYT2 .DAYT4
;DAYTIME
;THIS AND ALL ONE-WORD COMMANDS ARE CONFIRMED BEFORE DISPATCH.
.DAYTI: PRINT " "
GJINF
HRRZ D,A
MOVEI A,1
HRROI B,[ASCIZ /MRC/] ;WELL, <MGM> NO LONGER EXISTS AT CCA, AND
STDIR ;THE HACK WAS THERE, SO I DECIDED I WANTED IT!!
JRST .DAYT1
JRST .DAYT1
CAIN D,(A)
JRST .DAYT2
.DAYT1: SETZM D
.DAYT3: SETOM B
ODCNV
PUSH P,C
MOVE A,COJFN ;DESTINATION
SETOM E ;SUPER-VERBOSE
ODTNC
SETOM B
MOVSI D,500000 ;GMT
ODCNV
CAME C,(P)
JRST .DAYT4
PRINT " " ;SAME DAY
MOVSI E,400020
.DAYT5: MOVE A,COJFN
ODTNC ;PRINT GMT ALSO
PRINT EOL
SUB P,[1,,1]
RET
.DAYT2: MOVSI D,100010 ;PACIFIC TIME
JRST .DAYT3
.DAYT4: PRINT EOL ;DATE CHANGED, USE TWO LINE
PRINT " "
SETOM E
JRST .DAYT5
;;DEFINE (NEW FILE) <NAME> (AS) <OLD OR NEW NAME>
;;DECODER ONLY -- NOT TO BE IMPLEMENTED IN MINISYSTEM.
;
;.DEFIN: NOISE <new file>
; HRROI A, ;NO DEFAULT EXTENSION FOR FIRST FILE
; MOVEI B,B0+B1 ;"FOR OUTPUT USE" AND "MUST BE NEW" BITS
; CALL SPECFN ;GET FILE NAME USING GTJFN FLAGS IN B
; JRST CERR ;NO DEFAULT FOR "-" INPUT
; NOISE <as>
; MOVE A,[2,,2] ;SAY DEFAULT NAME AND EXT TO THOSE OF 1ST FILE
; MOVEI B,B3 ;SAY "TYPE OLD/NEW"
; ;THESE GTJFN BITS ACCEPT AN OLD OR NEW NAME BUT DEFAULT
; ;VERSION TO HIEST OLD RATHER THAN NEXT HIGHER AS "COUTFN" DOES.
; CALL SPECFN
; JRST CERR
; CONFIRM
; JRST NIM ;TYPE "NOT IN MINISYSTEM"
;.DELET DELET0 DELET2 DELET3 DELET1
;DELETE <FILE GROUP>
.DELET: MOVE A,[2,,2] ;SAY DEFAULT NAME & EXT TO PREVIOUS
HRLI B,-2 ;DEFAULT VERSION TO LOWEST
HRRI B,B2+B11+B15+B16 ;OLD FILE, *'S AND COMMA OK
CALL SPECFN ;INPUT FILE GROUP DESCRIPTOR
JRST CERR
ALLOW TSPC+TALT+TEOL
CONFIRM
CALL FRSTF ;TYPE NAME IF A GROUP
DELET0: HRRZ A,@INIFH1 ;JFN
DVCHR
TLNN B,(1B4) ;DISK?
JRST DELET1 ;NO
HRRZ A,@INIFH1
DELET2: MOVE B,[1,,FDBCTL] ;GET CONTROL BITS
MOVEI C,C ;TO C
CALL $GTFDB ;GET FDB OR DON'T SKIP
ERROR <DELET2: GTFDB error>
TLNE C,(FDBUND) ;CHECK THE PERPETUAL BIT
JRST [ UTYPE [ASCIZ / Cannot delete perpetual file
/]
JRST NEXTF] ;DO NEXT FILE
DELET3: MOVE B,[1,,FDBBCK] ;GET BACKUP WORD
MOVEI C,C ;TO C
CALL $GTFDB
ERROR <$GTFDB error>
TLNE C,FDBARC ;ARCHIVE BIT
JRST [ UTYPE [ASCIZ / Cannot delete archive-pending file
/]
JRST NEXTF] ;RETURNS TO FRSTF CALL +1
DELET1: MOVE A,@INIFH1 ;JFN(FLAGS TELL DELF WHETHER TO RELEASE)
DELF
CALL [ CAIN A,DELFX1
UERR [ASCIZ /Protection violation/]
JRST JERR]
JRST NEXTF ;GET NEXT FILE IF GROUP, TYPE NAME,
;RETURN TO WHERE FRSTF WAS CALLED.
;GO TO RLJFNS IF NO MORE FILES.
;.DDT DDT1 DDT2
;"DDT" COMMAND. LOAD DDT IN INFERIOR FORK IF NECESSARY,
;TRANSMIT SYMBOL TABLE POINTER, START DDT.
.DDT: SKIPGE DDTFLG ;DDT ALREADY LOADED?
JRST DDT4 ;YES
;DETERMINE WHETHER THERE IS INFERIOR FORK WITH SYMBOL TABLE POINTER
;IF NOT, USE DDT THAT ALREADY CONTAINS STENEX SYMBOLS.
SETZ C, ;SAYS NO SYM TAB PTR
SKIPGE FORK
JRST DDT2 ;NO FORK
;THERE IS A FORK, SEE IF IT ALREADY CONTAINS SOMETHING THAT LOOKS
;LIKE A DDT. IF SO, LEAVE IT, AS IT MAY CONTAIN BREAKPOINTS,
;MODIFIED SYM TAB PTR, ETC.
MOVEI A,DDTORG ;DDT BEGINNING ADDRESS
CALL MAPPF
TLNN A,B5 ;PAGE EXISTS?
JRST DDT1 ;NO, FORK DOESN'T HAVE DDT
CALL LOADF ;YES, LOAD FIRST WORD
CAMN A,[JUMPA DDTORG+10]
JRST DDT3 ;DATACOMPUTER HAS ITS OWN
CAME A,[JRST DDTORG+2]
JRST DDT1
MOVEI A,DDTORG+1
CALL LOADF ;SECOND WORD IS 0,,PTR PTR
CAIG A,-1
CAIG A,DDTORG
JRST DDT1
JRST DDT3 ;ALREADY HAVE ACCEPTABLE DDT
;FORK DOESN'T HAVE DDT, SEE IF IT HAS SYM TAB PTR
DDT1: MOVEI A,.JBSYM ;WHERE LOADER LEAVES SYM TAB PTR
CALL MAPPF ;MAP PAGE OF FORK
;SETZ C, ;SAYS NO SYM TAB PTR
TLNE A,B5 ;NO PAGE?
TLNN A,B2 ;READ PROTECT?
JRST DDT2 ;NO USEABLE PTR
;ANDI A,777
MOVE C,PAGEN(A) ;FETCH SYM TAB PTR WORD
;IF NEGATIVE, IT WILL BE ASSUMED TO BE PTR
MOVE D,PAGEN+1(A) ;.JBUSY IS .JBSYM+1
;NO CHECKING NEEDED, DDT WILL FIX IT UP.
DDT2: PUSH P,C ;SAVE SYM TAB PTR OR 0
PUSH P,D ;SAVE UNDEF SYM PTR
MOVE B,[POINT 7,[ASCIZ /<SUBSYS>SDDT.SAV/]] ;DDT WITH SYMBOLS
JUMPGE C,.+2 ;SYM TAB PTR CANT BE .GE. 0
MOVE B,[POINT 7,[ASCIZ /<SUBSYS>UDDT.SAV/]]
;LOAD SELECTED DDT
CALL $GTJFN ;ASSIGN JFN FOR STRING PTR IN B
;ENTRY TO "$LPT" SUBR NEAR "DIRECTORY"
CALL $MERGE ;MERGE IT INTO FORK, CREATING FORK IF NONE,
;AND RELEASE JFN
;DDT3 DDT4
;DDT...
;STORE SYMBOL TABLE POINTER
POP P,D
POP P,C
JUMPGE C,DDT3 ;NOT A SYMBOL TABLE POINTER
MOVEI A,DDTSYM
CALL MAPPF
ANDI A,777
HRRZ E,PAGEN+1(A) ;WHERE TO STORE UNDEF PTR
HRRZ A,PAGEN(A) ;POINTER TO WHERE TO PUT POINTER
CALL MAPPF
ANDI A,777
MOVEM C,PAGEN(A) ;STORE POINTER
HRRZ A,E ;WHERE TO PUT UNDEF PTR IN DDT
CALL MAPPF
ANDI A,777
MOVEM D,PAGEN(A) ;STORE IT
DDT3: SETOM DDTFLG ;SAY DDT LOADED & SYM TAB PTR MOVED
;TRANSFER CONTROL TO DDT
DDT4: MOVNI B,3 ;CODE FOR PA1050 IF ANY
CALL CHKPAT ;PA1050 RUNNING IN FORK?
JUMPG B,GOTO2 ;RETURNS RESTART ADDRESS IF YES
MOVEI B,DDTORG ;DDT STARTS AT ITS FIRST LOCATION
JRST GOTO2 ;JOIN "GOTO" COMMAND: UNMAP PAGE, START FORK.
;.DEASS .DUMP
;DEASSIGN <DEVICE NAME>
;ACCEPTS LOGICAL OR REAL DEVICE NAME
.DEASS: NOISE (device)
CALL DEVN ;INPUT DEVICE NAME
;NOW HAVE DEVICE DESGNATOR IN A, CHARACTERISTICS WORD IN B.
TLNN B,B6
ERROR <%1H: not assigned>
TLNN B,B5
ERROR <%1H: not assigned to you>
CONFIRM
TLNE B,B8 ;MOUNTED?
TLNN B,B7 ;MOUNTABLE?
JRST .+3 ;NOT MOUNTED OR NOT MOUNTABLE
DSMNT ;REDUCES CHANCES OF CLOBBEREING NEXT
CALL JERR ;...USER'S DECTAPE.
;MAY ALSO WRITE DIRECTORY IN SOME CASES (?)
RELD
CALL JERR
;DO WE HAVE TO DO ANYTHING TO FLUSH SYNONYMS HERE?
JRST CMDIN4
;"DETACH" CODE IS WITH "REDIRECT" BELOW.
;DUMP (ON) <FILE NAME>.
;SAVES ENVIRONMENT.
;CAN'T BE FULLY IMPLEMENTED TIL ENVIRONMENT SAVE FILES ARE SPECIFIED.
.DUMP: NOISE <on>
JRST NIYE ;←←←←←←←←←←←←←←←←←←←←
;.EDIT EDIT1 EDIT2 EDIT3 EDIT4 EDIT5 EDIT6 EDIT7 EDIT8
;EDIT (FILE)
;FIRES UP TECO AT CCL ENTRY WITH JFN OF FILE SPECIFED IN AC1
; DEFAULT FILE IS MOST RECENT VERSION OF THE LAST ONE MENTIONED
; IN AN "EDIT" COMMAND. THE ACTUAL NAME OF THIS IS SAVED AWAY IN
; "EDFILE" SO THAT IT IS PRESERVED THROUGH RESETS.
.EDIT: CALL CEDFN ;GET EDIT FILE NAME,DEFAULT=PREVIOUS
JRST EDIT7 ;NO FILE SPECIFIED
PUSH P,A ;SAVE THE JFN FOR STARTING TECO
CONFIRM
MOVE A,[EDFILE,,EDFILE+1]
SETZM -1(A) ;CLEAR DEFAULT POINTERS WORD
BLT A,EDFILE+EDFILL ;AND SAVED STRINGS
EDIT1: HRROI A,EDFILE+1 ;BEG OF STRING STORAGE
MOVE B,0(P) ;EDIT JFN
HRLZM A,EDFILE ;SET NAME HALF OF POINTER WORD
MOVSI C,(1B8) ;OUTPUT NAME OF JFN
JFNS
IBP A ;INSERT A NULL
HRROI A,1(A) ;BUMP TO NEXT WORD
HRRM A,EDFILE ;SET EXT HALF OF POINTER WORD
MOVSI C,(1B11) ;OUTPUT EXT OF JFN
JFNS
EDIT2:; MOVE A,0(P) ;GET EDIT JFN AGAIN
; MOVE B,[1,,FDBCTL]
; MOVEI C,C ;INTO C
; CALL $GTFDB ;GTFDB OR DON'T SKIP
; JRST CERR
; TLNN C,(1B4) ;SEE IF FIRST WRITE HAS BEEN DONE
; JRST EDIT3 ;IT HAS. DON'T CHANGE AUTHOR
; MOVE B,[7B5+1B22] ;7-BIT, APPEND
; OPENF ;MAKE SURE IT EXISTS
; JRST CERR
; TLO A,(1B0) ;DONT RELEASE THE JFN
; CLOSF ;TECO WILL OPEN IT
; CALL SCREWUP
EDIT3: HRROI B,[ASCIZ /<SUBSYS>TECO.SAV/]
CALL TRYGTJ ;GTJFN, STACK FOR RELEASE AT ERROR, ↑C
CALL CERR
PUSH P,A ;SAVE FOR LATER
EDIT4: CALL RESET ;FLUSH OLD FORK, IF ANY
CALL ECFORK ;GET A CLEAN ONE
MOVE A,['TECO ']
MOVEM A,SUBSYS
SETZM PROPSF ;SET "GET2B"
MOVEI B,GETILI ;SETUP TO CATCH
MOVEM B,ILIDSP ;ILLEGAL GET JSYS
POP P,A ;JFN ON TECO
HRL A,FORK
GET ;AND RELEASE JFN
SETZM ILIDSP ;TURN OFF SPECIAL ILL INSTR HANDLING
EDIT5: MOVEI A,1 ;REFERENCE AC1
CALL MAPPF
POP P,PAGEN(A) ;JFN FOR TECO TO GOBBLE DOWN
MOVE A,FORK
MOVEI B,PAGEN
SFACS ;MAPFF WON'T DO THIS
EDIT6: MOVEI B,2 ;CCL ENTRY
JRST START1 ;START UP THE TECO
EDIT7: SKIPN A,EDFILE ;IS THERE A SAVED FILE NAME.EXT?
CALL CERR ;NO
MOVE B,[CJFNBK,,CJFNBK+1]
SETZM -1(B)
BLT B,CJFNBK+10 ;CLEAR DEFAULT BLOCK
HLROM A,CJFNBK+4 ;DEFAULT NAME
HRROM A,CJFNBK+5 ;DEFAULT EXTENTION
MOVE B,[377777,,377777]
MOVEM B,CJFNBK+1 ;NO IO
MOVSI C,100000
MOVEM C,CJFNBK+0 ;OLD FILE ONLY, NO CONFIRM
EDIT8: MOVEI A,CJFNBK ;DEFAULT BLOCK PTR
MOVEI B,0 ;FORCE DEFAULTING
GTJFN
JRST [ SETZM EDFILE ;FORGET PAST FILE
UERR [ASCIZ /Edit file has been deleted/]]
MOVE B,JBUFP
PUSH B,A ;SAVE FOR RELEASING ON ERROR,ETC
MOVEM B,JBUFP
PUSH P,A ;WHERE REST OF EDIT WANTS THE JFN
CONFIRM
JRST EDIT3 ;FILE KNOWN TO EXIST, JUST GET TECO
;.ENTRY ENTRY5
;ENTRY (VECTOR LOCATION) <OCTAL> (LENGTH) <OCTAL>
.ENTRY: SKIPGE FORK
ERROR <No program>
NOISE <vector location>
CALL OCTAL
JRST CERR
ALLOW TALT+TEOL+TSPC
PUSH P,A
MOVEI A,1 ;DEFAULT LENGTH
TRNE CBT,TEOL
JRST ENTRY5
NOISE <length>
CALL OCTAL ;OCTAL TO ALLOW 254000 FOR COMPATIBILITY
JRST [ UALTYP [ASCIZ /1 /] ;NULL INPUT
MOVEI A,1 ;DEFAULT LENGTH AGAIN
JRST .+1]
ALLOW TALT+TEOL+TSPC
CAILE A,777 ;TOO LONG?
JRST [ CAIN A,254000 ;ALLOW JRST FOR COMPATIBLE
JRST .+1
JRST CERR] ;"?"
ENTRY5: CONFIRM
POP P,B ;LOCATION
HRL B,A ;LENGTH
MOVE A,FORK
SEVEC
RET
;.NOTEP .EPHEM
;"NOT EPHEMERAL" TURNS OFF FDBEPH BIT IN FDB
.NOTEP: TDZA 1,1 ;0 FOR USE IN CHFDB
;"EPHEMERAL" TURNS ON THE FDBEPH BIT
.EPHEM: SETOM 1 ;1 FOR USE IN CHFDB
PUSH P,1
CALL $GET1 ;GET A PROGRAM JFN, LIKE "GET" OR "RUN"
ALLOW TSPC+TALT+TEOL
CONFIRM
MOVE 1,CJFN1 ;JFN OF THE NAMED FILE
DVCHR
TLNN 2,(1B4)
ERROR <%1H doesn't have ephemerons>
HRR 1,CJFN1
HRLI A,FDBCTL ;FDB CONTROL BITS WORD
MOVSI 2,(FDBEPH)
POP P,3
CHFDB
JRST RLJFNS ;RELEASE JFN AND RETURN
;.EXEC EXEC1 .NEXEC
;'EXEC' - STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK'
.EXEC: SKIPLE XFORK
JRST EXEC1
MOVSI A,(1B2+1B17)
HRROI 2,[ASCIZ /<SYSTEM>EXEC.SAV/]
CALL TRYGTJ ;GTJFN AND SAVE IT
CALL JERR
PUSH P,A
MOVSI A,(1B1+1B3)
MOVEI B,STRTAC ;TRANSMIT CAPS AND ACS
CFORK
CALL JERR
MOVEM A,XFORK
POP P,A
HRL A,XFORK
GET
EXEC1: TLNE Z,F1
JRST .NEXEC ;NO EXEC
MOVE A,XFORK
SETZM B
SFRKV
WFORK
RET
.NEXEC: INTOFF
SETOM A
EXCH A,XFORK
SKIPLE A
KFORK
JFCL
INTON
RET
;.EXPUN $EXPUN ..EXAL ..EXDL ..EXPE ..EXSC ..EXTM ..EXPU
;EXPUNGE (DELETED FILES)
.EXPUN: KEYWD $EXPUN
T ALL,EOLOK+LPROK,..EXAL
JRST CERR
JRST (KWV)
$EXPUN: TABLE
T ALL,EOLOK+LPROK,..EXAL
T DELETED,EOLOK+LPROK,..EXDL
T PERMANENT,INVIS+CONMAN+WHLUO+OPRUO+EOLOK+LPROK,..EXPE
T SCRATCH,EOLOK+LPROK,..EXSC
T TEMPORARY,EOLOK+LPROK,..EXTM
TEND
..EXAL: NOISE <deleted, scratch, and temporary files>
HRLZI 1,(1B12!1B13!1B15!1B16)
JRST ..EXPU
..EXDL: NOISE <files>
HRLZI 1,(1B12!1B13)
JRST ..EXPU
..EXPE: NOISE <files>
HRLZI B,WHLUO+OPRUO
CALL PRVCK ;SEE THAT REQUIRED CAPS ARE ENABLED
HRLZI 1,(1B14)
JRST ..EXPU
..EXSC: NOISE <files>
HRLZI 1,(1B15)
JRST ..EXPU
..EXTM: NOISE <files>
HRLZI 1,(1B16)
..EXPU: PUSH P,1
ALLOW TSPC+TALT+TEOL
CONFIRM
GJINF
HRR 1,2
HLL 1,0(P)
DELDF
SUB P,[1,,1]
RET
;.FORK FORK1 FORK2
;FORK <OCTAL FORK HANDLE>
;SETS FORK ACCESSED BY START, REENTER, GOTO, /, \, TEN50 DDT, SAVE.
;DOESN'T UPDATE SUBSYSTEM NAME (SUBSYS); MAYBE LATER IT SHOULD.
.FORK: CALL OCTAL
JRST CERR
ALLOW TALT+TSPC+TEOL
TRO A,400000 ;OK IF USER OMITS SIGN
CAIN A,400000 ;"SELF" IS LEGAL ONLY FOR WHEELS.
JRST [ HRLZI B,WHLUO ;INDICATE WHEEL PRIV MUST BE ENABLED
CALL PRVCK ;TEST SPECIAL CAPABILITIES
JRST FORK1 ;NO ENABLE OR NO WHEEL CAPABILITY
JRST FORK2]
CAIL A,400001
CAILE A,400017
FORK1: ERROR <Fork handle must be between 1 and 17>
FORK2: PUSH P,A
RFSTS ;SEE IF THIS FORK HANDLE IS ASSIGNED.
TLNE A,077700 ;DISTINGUISH -1 FROM 0-5, 400000-400005.
ERROR <No such fork> ;-1 = UNASSIGNED HANDLE.
CONFIRM
POP P,FORK ;SAVE HANDLE FOR OTHER COMMANDS TO USE
JRST CMDIN4
;.MERGE $MERGE $GET1 $GET11
;MERGE <FILE> COMMAND.
;GETS A FILE INTO CURRENT FORK WITHOUT RESETTING.
;PUTS BACK ENTRY VECTOR WORD THAT WAS THERE BEFORE COMMAND
.MERGE: CALL $GET1 ;INPUT PROGRAM NAME
ALLOW TSPC+TEOL+TALT
CONFIRM
;SUBROUTINE ENTRY FOR "DDT" COMMAND. JFN IN CJFN1.
$MERGE: SKIPGE A,FORK ;SKIP IF EXEC HAS INFERIOR FORK
JRST $GET2 ;CREATE FORK, GET PROG, USE ITS ENTRY.
GEVEC ;ALREADY HAVE A FORK
PUSH P,B ;SAVE SAME
CALL $GET2 ;GET PROGRAM
POP P,B ;PREVIOUS ENTRY VECTOR
MOVE A,FORK ;FORK HANDLE AGAIN
JUMPE B,.+2 ;JUMP IF THERE WAS NO ENTRY VECTOR WD
SEVEC ;SET ENTRY VECTOR TO OLD VALUE
RET
;SUBROUTINE TO INPUT A PROGRAM NAME.
;FIRST PART OF GET, RUN, MERGE.
$GET1: NOISE (file)
$GET11: SETZ A, ;SAY DEFAULT TO CONNECTED DIRECTORY
CALL CPFN ;INPUT PROGRAM NAME AND ASSIGN JFN
JRST [ TRNE CBT,TEOL ;FAIL.
JRST CERR ;AFTER CR TYPE "?" AND ABORT COMMAND.
UTYPE [ASCIZ /? /] ;OTHER TERMINATORS, " ? " AND RETRY.
MOVE BFP,.BFP ;BACK UP COMMAND BUFFER POINTER
BTCHER ;STOP IF NON-INTERACTIVE
JRST $GET11] ;GO RETRY.
RET
;.ERUN ERUN0
;ERUN <FILE> COMMAND = RUN PROGRAM AS AN EPHEMERON
.ERUN: NOISE (file)
ERUN0: CAIE CHR,"<" ;WAS DIRECTORY SPECIFIED?
TLO Z,F3 ;NO - DO DEFAULT SEARCHES THROUGH CONNECTED & LOGIN
MOVEI A,[ASCIZ /SUBSYS/] ;DEFAULT DIRECTORY NAME
CALL CPFN ;INPUT PROGRAM NAME AND ASSIGN JFN
JRST [ TRNE CBT,TEOL ;FAIL.
JRST CERR ;AFTER CR TYPE "?" AND ABORT COMMAND.
UTYPE [ASCIZ /? /] ;OTHER TERMINATORS, " ? " AND RETRY.
MOVE BFP,.BFP ;BACK UP COMMAND BUFFER POINTER
BTCHER ;STOP IF NON-INTERACTIVE
JRST ERUN0] ;GO RETRY.
JFCL ;HOW MANY RETURNS DOES THIS THING REALLY HAVE?
JRST CIN4A
;.RUN .GET GET1
;RUN <FILE> COMMAND = GET + START
.RUN: PUSH P,[..STRT] ;SET RETURN TO JOIN "START" COMMAND,
;FALL INTO "GET".
;GET <FILE> COMMAND.
;RESETS THEN CREATES ONE FORK AND GETS PROGRAM INTO IT.
;CODED IN SUBROUTINES SO CODE CAN BE SHARED WITH "MERGE".
.GET: CALL $GET1 ;INPUT PROGRAM NAME
;<SUBSYSTEM NAME> JOINS HERE AFTER CALLING CPFN AND SETTING
; RETURN TO JOIN START COMMAND (..STRT).
GET1: ALLOW TSPC+TEOL+TALT
CONFIRM
CALL RESET ;CLOSE FILES, KILL ALL INFERIOR FORKS.
;NOW FALL INTO $GET2, WHICH WILL RETURN
;TO COMMAND INPUT FOR "GET" BECAUSE
;DISPATCH WAS WITH "PUSHJ".
;$GET2 GET2B GETILI
;GET...
;SUBROUTINE TO GET A PROGRAM INTO CURRENT FORK, FOR GET, RUN, AND MERGE.
;AT ENTRY CJFN1 MUST CONTAIN JFN OF FILE TO GET.
$GET2: SKIPL FORK ;IS THERE A FORK?
JRST GET2B ;YES (HAPPENS FOR "MERGE")
CALL ECFORK ;CREATE A FORK
MOVE B,CJFN1 ;JFN
CALL SUBNAM ;SUBSYS NAME TO CELL "SUBSYS",
;FOR USE WHEN FORK IS RUN (LTTYMD)
GET2B: SETZM PROPSF ;"PROPRIETARY" FLAG, MAY BE SET IF
;APPROPRIATE
;NOW WHAT? TEST FILE'S PROTECTION? ←←←←←
MOVEI A,GETILI ;SET SPECIAL IL INST TRAP DISPATCH
MOVEM A,ILIDSP ;SO "GET" ERRORS CAN BE DETECTED
HRR A,CJFN1
HRL A,FORK
GET
SETZM ILIDSP ;CLEAR IL INST SPECIAL DISPATCH ADDRESS
CALL RLJFNS ;RELEASE JFNS
;ANYTHING ELSE?
RET
;ILLEG INST TRAP DURING GET JSYS
;TYPE EXEC ERROR MESSAGES FOR CERTAIN ERRORS
GETILI: PUSH P,A
MOVE A,ERCOD ;SYSTEM ERROR CODE
CAIN A,GETX1
ERROR <Bad core save file format>
CAIN A,GETX2
ERROR <System special pages table full>
CAIN A,OPNX3
ERROR <Program protected>
POP P,A
JRST ILIPSI ;OTHER ERRORS TREATED IN GENERAL MANNER
;ECFORK
;CREATE FORK FOR PROGRAM. USED HERE AND FOR "\"
ECFORK: MOVEI A,-1 ;NO OPTIONS, REDICULOUS PC
CFORK
ERROR < No forks available>
MOVEM A,FORK ;HANDLE OF CURRENT INFERIOR
FFORK ;LEAVE IT FROZEN
;TRANSMIT SPECIAL CAPABILITIES POSSIBLE TO NEW INFERIOR FORK,
; ENABLED IF ENABLED IN THIS EXEC.
;LATER SHOULD ONLY TRANSMIT RH, LH B0-B8 SHD COME FROM FILE ←←←←←←←←←←
MOVE A,FORK
MOVE B,[777000,,777777] ;XMIT WHEEL, ETC. BITS 0-8
;WILL COME FROM FILE EVENTUALLY
SKIPE C,PRVENF ;IF USER HAS "ENABLE"D IN THIS EXEC,
MOVE C,B ;ENABLE TRANSMITTED CAPABILITIES
EPCAP
MOVE A,[INPTTY,,PTTYMD]
BLT A,PTTYMD+NTTYMD-1 ;SETUP INITIAL TTY MODES
RET
;SUBNAM SUBN4 SUBN4A SUBN5
;SUBNAM
;SUBR THAT CONVERTS JFN IN B TO APPROPRIATE SUBSYSTEM NAME WORD
; FOR "SETNM" JSYS.
;STORES IN CELL "SUBSYS", DOESN'T "SETNM".
;TRANSPARENT, ONE USE IN "GET" CODE.
SUBNAM: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
;GET STRING FOR GIVEN JFN
MOVE A,CSBUFP
;JFN IS IN B
MOVE C,[1B2+1B5+1B8+1B35]
JFNS ;DEVICE:<DIRECTORY>NAME
SETZ A, ;CONV DIR NAME TO SIXBIT IN A
MOVEI B,6
MOVE D,[POINT 6,A,-1]
ILDB C,CSBUFP
CAIE C,"<" ;LOOK FOR START OF DIR NAME
JRST .-2
ILDB C,CSBUFP
CAIE C,">" ;END OF DIR NAME?
JRST [ SUBI C,40 ;NO, CONV TO SIXBIT
JUMPLE B,.-2 ;DON'T STORE IF ALREADY 6 CHARS
IDPB C,D
SOJA B,.-2]
CAME A,['SUBSYS'] ;BELIEVE SUBSYS OR HACKS DIRECTORY
; CAMN A,['HACKS ']
; JRST SUBN4
CAMN A,['SYSTEM']
JRST SUBN4 ;BELIEVE SYSTEM, TOO
MOVE A,['(PRIV)'] ;PRIVATE DIRECTORY, USE (PRIV)
JRST SUBN5
;COMPARE SUCCEEDED, PACK SUBSYSTEM FILE NAME INTO SIXBIT AND USE IT.
SUBN4: SETZ A,
MOVE B,[POINT 6,A,-1]
MOVEI D,6
SUBN4A: ILDB C,CSBUFP
JUMPE C,SUBN5 ;END OF NAME, DONE
TRC C,40 ;CONVERT TO SIXBIT
IDPB C,B
SOJG D,SUBN4A ;ALSO STOP AT 6 CHARS
SUBN5: MOVEM A,SUBSYS ;SUBSYS=PTTYMD+10
JRST [ POP P,D
POP P,C
POP P,B
POP P,A
RET]
;.GOTO GOTO2
;GOTO <OCTAL #>
.GOTO: CALL OCTAL
JRST CERR
ALLOW TSPC+TALT+TEOL
MOVE B,A ;ADDRESS INTO B FOR USE BELOW
SKIPGE FORK ;CHECK HANDLE OF FORK KNOWN TO EXEC
ERROR <No program>; ;NONE AT ALL
CALL MAPPF ;MAP PAGE CONTAINING ADDRESS. GETS ACCESS.
TLNN A,B5
ERROR <No such page>
TLNN A,B4
ERROR <Can't execute that page>
CONFIRM
CALL CHKPAT ;SETUP STUFF FOR PA1050 IF LOADED
;START FORK AT ADDRESS IN B
;"DDT" JOINS HERE
GOTO2: SETO A,
CALL MAPPF ;UNSHARE MAPPED PAGE, IF ANY
MOVEI E,PTTYMD ;SET UP PROGRAM'S TELETYPE MODES
CALL LTTYMD ;..
TLO Z,RUNF ;SAY PROGRAM'S TELETYPE MODES ARE IN EFFECT
CALL IFORK ;PREPARE FORK(S) AND SETUP LRFORK
TLNN B,1 ;DON'T START IF LH NON-0
SFORK ;START FORK (USES A AND B)
JRST WAIT ;WAIT FOR IT TO TERMINATE
;.BDDT BDDT1 BDDT5 .NOBD
; "BDDT" COMMAND AND "NO BDDT" COMMANDS
;F1 IS CLEARED BY MAIN DISPATCH (TO .BDDT) AND SET BY "NO"
REPEAT 0,<
.BDDT: TLNE Z,F1 ;"NO BDDT" COMMAND?
JRST .NOBD
SETOM A
CALL MAPPF ;UNMAP ANY INFERIOR PAGE
INTOFF ;WHILE THINGS ARE UP IN THE AIR
MOVEI 1,BDFORK ;POINTER TO WHICH TO SETUP
CALL CDBGFK ;CREATE DEBUGGER AND/OR USER FORKS
JRST BDDT5 ;ALREADY EXISTS
BDDT1: HRROI 2,[ASCIZ /<SUBSYS>BDDT.SAV/]
MOVE 3,['BDDT ']
CALL LDRUND ;LOAD AND RUN IT
INTON
JRST WAIT
BDDT5: CALL RSPLIC ;RESPLICE UFORK UNDER (DBFORK), REENTER
INTON
JRST WAIT
; "NO BDDT" COMMAND
.NOBD: INTOFF
MOVEI 1,BDFORK ;OLD SUPERIOR
MOVEI 2,IDFORK ;DESIRED NEW SUPERIOR
CALL USPLIC ;DO THE UNSPLICE/RESPLICE
INTON
RET
>
;.IDDT IDDT1 IDDT5 .NOID
; "IDDT" COMMAND AND "NO IDDT" COMMANDS
;F1 IS CLEARED BY MAIN DISPATCH (TO .IDDT) AND SET BY "NO"
.IDDT: TLNE Z,F1 ;"NO IDDT" COMMAND?
JRST .NOID
SETOM A
CALL MAPPF ;UNMAP ANY INFERIOR PAGE
INTOFF ;WHILE THINGS ARE UP IN THE AIR
MOVEI 1,IDFORK ;POINTER TO WHICH TO SETUP
CALL CDBGFK ;CREATE DEBUGGER AND/OR USER FORKS
JRST IDDT5 ;ALREADY EXISTS
IDDT1: HRROI 2,[ASCIZ /<SUBSYS>IDDT.SAV/]
MOVE 3,['IDDT ']
CALL LDRUND ;LOAD AND RUN IT
INTON
JRST WAIT
IDDT5: CALL RSPLIC ;RESPLICE UFORK UNDER (DBFORK)
INTON
JRST WAIT
; "NO IDDT" COMMAND
.NOID: INTOFF
MOVEI 1,IDFORK ;OLD SUPERIOR
SETO 2,
;; MOVEI 2,BDFORK ;DESIRED NEW SUPERIOR
CALL USPLIC ;DO THE UNSPLICE/RESPLICE
INTON
RET
;CDBGFK
;ROUTINES USED BY COMMANDS WHICH RUN PROGRAMS SUCH AS IDDT, BDDT,
; TENEX LOADERS, ETC. THESE ALL OPERATE ON A "USER FORK". WHEN
; THE COMMAND IS INVOKED, THE USER IS SPLICED UNDER THE FORK
; CONTAINING THE OPERATIONAL PROGRAM
;VARIABLES INVOLVED ARE:
; UFORK: CONTAINS -1 OR HANDLE OF USER FORK
; IDFORK: -1 OR HANDLE OF FORK CONTAINING IDDT
; BDFORK: -1 OR HANDLE OF FORK CONTAINING BDDT
; DBFORK: CONTAINS THE ADDRESS (IDFORK, BDFORK, ETC) OF THE
; DEBUGGER (OR WHATEVER) CURRENTLY SPLICED ABOVE THE USER.
; FORK: (NO CHANGE) THE FORK THE EXEC IS CURRENTLY CONSIDERING
; FOR THINGS LIKE ↑T, MEMSTAT, ETC.
; LRFORK: (NO CHANGE) FORK WHICH WILL BE RESUMED BY CONTINUE.
;CREATE THE DEBUGGER FORK AND/OR USER
; 1: POINTER TO CELL TO REMEMBER THE HANDLE
; SKIPS IF NEW FORK WAS CREATED FOR DEBUGGER
CDBGFK: SKIPL 0(1) ;IS THERE A DEBUGGER ALREADY?
RET ;YES, NO-SKIP RETURN
PUSH P,1
SKIPGE FORK ;IS THERE AN INFERIOR?
CALL ECFORK ;NO, MAKE ONE
PUSH P,FORK ;SAVE INFERIOR
CALL ECFORK ;GET A NEW FORK
MOVE 1,FORK ;NEW FORK
POP P,FORK ;USER FORK
MOVEM 1,@0(P) ;SETUPT IDFORK OR BDFORK, ETC
POP P,1
MOVEM 1,DBFORK ;REMEMBER AS SUPERIOR OF UFORK
AOS 0(P) ;SKIP RETURN
RET
;LDRUND LDRUN2 LDRUN3 LDRUN4
;LOAD AND RUN THE DEBUGGER
; 1: POINTER TO LOCATION CONTAINING THE HANDLE
; 2: POINTER TO ASCIZ FILE NAME
; 3: SETNM WORD
LDRUND: PUSH P,1 ;LOCATION CONTAINING HANDLE
PUSH P,3 ;SIXBIT OF 2
MOVSI 1,(1B2!1B17) ;OLD, SHORT
GTJFN
JRST [ SETOM 1
EXCH 1,@-1(P)
KFORK
JRST CERR]
HRL 1,@-1(P) ;FORM FORK.JFN
GET
MOVE 1,@-1(P)
GEVEC
HLRZS 2 ;GET LENGTH
CAIGE 2,3
JRST [ SETOM 1
EXCH 1,@-1(P)
KFORK
UERR [ASCIZ /New program required/]]
LDRUN2: MOVE 1,@-1(P)
MOVE 2,FORK
MOVEM 2,UFORK ;REMEMBER WHERE THE USER IS
SPLFK ;MAKE B INFERIOR TO A
CALL [ PUSH P,1 ;SAVE ERROR CODE
SETO 1,
EXCH 1,@-2(P)
KFORK
POP P,1
JRST JERR] ;GO SAY ERROR FROM JSYS
LDRUN3: MOVEM 1,PAGEN+1 ;HANDLE BY WHICH DEBUGGER WILL KNOW INF.
POP P,SUBSYS ;SIXBIT SUBSYSTEM NAME
MOVEI 2,PAGEN
MOVE 1,@0(P)
SFACS
MOVEI 2,2
LDRUN4: SFRKV ;AT SPLICED ENTRY
MOVEM 1,LRFORK ;FORK TO RUN IS DEBUGGER
MOVEI E,PTTYMD ;RESTORE TTY MODES
CALL LTTYMD
TLO Z,RUNF ;TELL ↑C ROUTINE WHAT TO DO
POP P,1
RET
;USPLIC RSPLIC RSPLI5
;UNSPLICE
; 1: POINTER TO CELL CONTAINING HANDLE OF OLD SUPERIOR
; 2: POINTER TO CELL CONTAINING OF DESIRED NEW SUPERIOR
USPLIC: SKIPG 0(1) ;ANY OLD SUPERIOR?
RET ;NO
SKIPG UFORK
CALL SCREWUP ;DEBUGGER WITH NO INFERIOR?
PUSH P,1
SKIPG 1,0(2) ;NEW SUPERIOR SPECIFIED?
MOVEI 1,400000 ;NO, USE THE EXEC ITSELF
MOVE 2,UFORK ;GET HANDLE OF USER FORK
MOVEM 2,FORK ;POINT THE EXEC AT HIM
MOVEM 2,LRFORK ;THAT IS THE FORK TO RESUME WITH A CONT.
SPLFK
CALL SCREWUP
POP P,2
SETO 1,
EXCH 1,0(2)
KFORK
RET
;RESPLICE THE USER FORK UNDER THE DEBUGGER FORK IF NEEDED
; 1: POINTER TO CELL CONTAINING DEBUGGER FORK HANDLE
RSPLIC: PUSH P,1 ;SAVE POINTER TO HANDLE
PUSH P,0(1) ;SAVE ACTUAL HANDLE
CAMN 1,DBFORK ;USER ALREADY UNDER DEBUGGER?
JRST RSPLI5 ;YES
MOVE 1,0(P) ;GET DEBUGGER HANDLE
MOVE 2,UFORK ;FORK CONTAINING THE USER
SPLFK
CALL SCREWUP
RSPLI5: POP P,1
MOVEI 2,1 ;REENTER ADDRESS
SFRKV
MOVEM 1,LRFORK
MOVEI E,PTTYMD
CALL LTTYMD ;LOAD PROGRAM'S TTY MODES
TLO Z,RUNF
POP P,DBFORK ;POINT AT WHICH DEBUGGER IS IN USE
RET
;.INTER .FINGE .SINK
;INTERROGATE (THE ARCHIVE)
REPEAT 0,<
;NOTE: THE INTERROGATE PROGRAM EATS THE REST OF THE COMMAND LINE.
.INTER: ALLOW TSPC+TALT
HRROI 2,[ASCIZ /<SYSTEM>ARCHIVE-LOOKUP.SAV/]
CALL TRYGTJ
ERROR <No lookup program>
TLO KWV1,PROGX ;SAY CONFIRMATION TO BE DONE BY LOOKUP
JRST CIN4 ;GO HANDLE AS AN EPHEMERON
>
;GIVE SOMEBODY THE FINGER
.FINGE: ALLOW TSPC+TALT+TEOL
HRROI 2,[ASCIZ /<SUBSYS>FINGER.SAV/]
CALL TRYGTJ
ERROR <My FINGER is broken>
TLO KWV1,PROGX ;SAY CONFIRMATION TO BE DONE BY LOOKUP
JRST CIN4A ;GO HANDLE AS AN EPHEMERON
;SINK ALL OUTPUT (FOR LINKS)
.SINK: ALLOW TSPC+TALT+TEOL
HRROI 2,[ASCIZ /<MISC>SINK.SAV/]
CALL TRYGTJ
ERROR <No SINK>
TLO KWV1,PROGX ;SAY CONFIRMATION TO BE DONE BY LOOKUP
JRST CIN4A ;GO HANDLE AS AN EPHEMERON
;.JFNCL
;JFNCLOSE <JFN>
.JFNCL: CALL OCTAL
JRST CERR
ALLOW TSPC+TALT+TEOL
CAIG A,77
CAIGE A,0
JRST CERR
GTSTS
TLNN B,B10
JRST CERR ;INVALID OR UNASSIGNED JFN
CONFIRM
MOVE B,JBUFP
PUSH B,A ;PUT JFN IN STACK WHERE RLJFNS LOOKS
MOVEM B,JBUFP
JRST RLJFNS ;CLOSE IF OPEN, AND RELEASE JFN.
;.LIMIT $LIMIT .CORE .CPU .DISK .KILOC
;LIMIT (ADDITIONAL) CORE/CPU/DISK/KILOCORESECS (TO) N
REPEAT 0,<
.LIMIT: NOISE <additional>
KEYWD $LIMIT
T CPU,LPROK ;IS CPU THE RIGHT THING TO DEFAULT TO?
JRST CERR
NOISE <to>
CALL DECIN ;READ A NUMBER INTO A
ALLOW TEOL+TALT+TSPC+TLPR
JRST (KWV) ;DISPATCH
$LIMIT: TABLE
T CORE,LPROK
T CPU,LPROK
T DISK,LPROK
T KILOCORESECS,LPROK
TEND
.CORE: NOISE <pages>
CAILE A,1000
ERROR <More than 512 pages !?>
CONFIRM
;NOW WHAT?
JRST NIYE
.CPU: NOISE <seconds>
CAILE A,↑D720
ERROR <More than 12 hours ???>
CONFIRM
JRST NIYE
.DISK: NOISE <disk blocks>
CAILE A,↑D2000 ;?
ERROR <Too much>; ;ETC
CONFIRM
JRST NIYE
.KILOC: ALLOW TEOL+TALT+TSPC ;NO NOISE WORD
CAILE A,↑D1000 ;?
ERROR <Too much>
CONFIRM
JRST NIM ;SAY "NOT IN MINISYSTEM"
>
;.LINK
;LINK (TERMINAL/USER)
.LINK: NOISE (to)
CALL TTYNUM ;GET LINE NUMBER, MAYBE FROM USER NAME
MOVEI B,400000(A) ;FORM TTY DESIGNATOR
HRLOI A,(1B2!1B3) ;TO AND FROM CONTROLLING TTY
TLINK
ERROR <Refused>
RET
;"LIST" IS WITH "TYPE" BELOW.
;.LOGIN LOGIN0 LOGIN1
;LOGIN COMMAND
;LOGIN (USER) <NAME> (PASSWORD) <NOT ECHOED> (ACCOUNT [#]) <#>
.LOGIN: SKIPLE CUSRNO
ERROR <You are already logged in>
CALL LGNCHK ;TYPE MSG IF LOGINS ARE PROHIBITTED
JUMPE A,LOGIN0 ;NOTHING WAS TYPED, PROCEDE
TYPE <
You may attach to an existing job> ;PROVIDE ADDITIONAL INFO
RET
;DECODE ARGUMENTS
;TWO GENERAL FORMS ACCEPTED: ARGS ON SAME LINE, TERMINATED WITH
;SPACE OR ALT MODE, AND ARGS ON SEPARATE LINES, TERMINATED WITH EOL.
;SECOND FORM IS INCONSISTENT WITH REST OF EXEC LANGUAGE BUT WAS ADDED
;BECAUSE IT MAKES HDX LOGIN CLEANER: ON HALF DUPLEX TTY, PASSWORD
;IS INPUT ON A SEPARATE LINE WHERE A MASK HAS BEEN TYPED.
;SPECIAL HANDLING OF EOL AS A TERMINATOR IS DONE BY THE "SPECEOL" SUBR
;WHICH IMMEDIATELY FOLLOWS "LOGIN" IN THIS LISTING.
LOGIN0: JUMPE KWV,LOGIN1 ;SKIP "USER" PROMPT IF IMPLICIT LOGIN
CALL SPECEOL ;HANDLE TERMINATOR FOR THE WORD "LOGIN"
;FIRST ARGUMENT: USER NAME
NOISE <user>; ;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
LOGIN1: CALL USERN ;INPUT USER NAME, XLATE TO USER # IN A
;USE "DIRNAM" IF RECOGNITION DESIRED
PUSH P,A ;SAVE INFO RETURNED BY "STDIR"
TLNE A,B0
ERROR <You cannot log in under that directory name>
CALL SPECEOL ;HANDLE TERMINATOR OF "USER" FIELD
;2ND ARGUMENT: PASSWORD
HRRZ A,(P) ;USER #
CALL PASWD ;INPUT PASSWORD, RETURN POINTER IN A.
PUSH P,A ;SAVE PTR FOR USE IN "LOGIN" JSYS CALL
;3RD ARGUMENT: ACCOUNT NUMBER
; MOVE A,-1(P) ;WHAT STDIR RETURNED:B1 SAYS STRING ACCT
; TLNN A,B1
; NOISE <account #>; IF USER REQUIRES NUMERIC ACCOUNT
; TLNE A,B1
; NOISE <account>; IF USER REQUIRES STRING
; CALL ACCT ;INPUT AND DECODE ACCT # (USES A)
; PUSH P,A ;SAVE FOR LOGIN JSYS
PUSH P,[500000,,↑D13]
PUSH P,B ;SAVE PIE SLICE
CONFIRM ;CONFIRM THE WHOLE COMMAND
;LOGIN...
;ALL ARGS DECODED, NOW LOG THE GUY IN
SETOM MESMSF ;SAY TYPE "YOU HAVE A MESSAGE" IF
;APPROPRIATE, EVEN AFTER ↑C'S
POP P,D ;PIE SLICE
POP P,C ;ACCT # OR PTR THERETO
POP P,B ;PASSWORD PTR
HRRZ A,(P) ;USER #
LOGIN
CALL [ CAIN A,LGINX1 ;CHECK FOR A FEW ERRORS NOT CHECKED B4.
UERR [ASCIZ /Illegal account/]
JRST JERR] ;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
MOVE B,(P) ;WHAT "STDIR" RETURNED
HRRZM B,CUSRNO ;STORE USER NUMBER
PUSH P,A ;SAVE DATE & TIME OF LAST LOGIN
;UPDATE SPECIAL CAPABILITIES
MOVEI A,B0
RPCAP
HLLZ C,B
SKIPE PRVENF
HRR C,B
EPCAP
;LOGIN6 LOGI61 LOGIN7 LOGIN8
;LOGIN...
;KILL AUTOLOGOUT FORK WHICH WATCHES FOR ABANDONED JOB
SKIPG ALOFH ;AUTOLOGOUT FORK HANDLE, OR 0 OR -1
JRST LOGIN6 ;NO AUTOLOGOUT FORK - EG STARTUP FAILED
INTOFF
MOVE A,ALOFH
KFORK ;KILL THE FORK
SETOM ALOFH ;SAY THE ALO FORK HAS BEEN KILLED
INTON
;TYPE "JOB <N> ON LINE N <DATE> <TIME>"
LOGIN6: ETYPE < Job %J on %L %D %E>
PRINT EOL
IFN 1,< ;I LIKE THIS FEATURE, MAYBE REMOVE AGAIN THOUGH?
SKIPN B,0(P) ;THE DATE
JRST LOGI61
ETYPE < Previous login: %2D %E>
>
LOGI61: CALL JOBCNT ;PRINT OTHER JOBS IF ANY FOR THIS USER
;TYPE SYSTEM LOGIN MESSAGE IF THERE IS ONE
LOGIN7: PRINT EOL
POP P,A ;DATE & TIME OF LAST LOGIN
POP P,B ;WHAT STDIR RETURNED
TLNE B,B2 ;B2 SAYS ALWAYS PRINT LOGIN MESSAGE
JRST LOGIN8 ;EXCEPT AT CCA B2=> NO LOGIN MESSAGES
; SETZ A, ;SET DATE TO 0 TO FORCE PRINTING
MOVE B,[POINT 7,[ASCIZ /<DOCUMENTATION>MESSAGE.TXT/]]
CALL MESS
MOVE B,[POINT 7,[ASCIZ /<DOCUMENTATION>LOGIN.MESSAGES/]]
CALL MESS ;TYPE FILE IF IT IS NEW ENOUGH
;TYPE "YOU HAVE A MESSAGE" IF THE MESSAGE FILE IN THIS DIRECTORY
; HAS NOT BEEN READ SINCE THE LAST TIME IT WAS WRITTEN. ALSO RUN
; USER'S INIT FILE.
LOGIN8: CALL MESMES
HRROI 2,[ASCIZ /[-LOGINIT-].SAV/]
CALL TRYGTJ
JRST CMDIN4
TLO KWV1,PROGX ;SAY CONFIRMATION TO BE DONE BY LOOKUP
JRST CIN4A ;GO HANDLE AS AN EPHEMERON
;SPECEOL USERN USERN2 LGNCHK TYPE <
;SPECEOL
;SUBROUTINE TO HANDLE EOL AS FIELD TERMINATOR IN THE MIDDLE OF A COMMAND
; IN THE SPECIAL MANNER REQUIRED FOR "LOGIN".
;CR NORMALLY TERMINATES COMMAND, DEFAULTING ANY FOLLOWING FIELDS.
;BUT IF TRM=EOL AND THIS SUBROUTINE IS CALLED AND A "NOISE"
; MACRO FOLLOWS THE CALL, THE FOLLOWING NOISE WORD IS TYPED
; (AS AFTER ALT MODE), PARENTHESIZED TEXT IS IGNORED (AS AFTER SPACE),
; AND FIELD IS INPUT NORMALLY, NOT DEFAULTED.
SPECEOL:ALLOW TSPC+TALT+TEOL+TLPR
TRNN CBT,TEOL
RET
CALL PASCOM ;AFTER SEMICOLON PASS CHARACTERS TO EOL
;RETURN "!" IN AC "TRM". THIS CAUSES "NOISE" TO DO THE REQUIRED
;SPECIAL PROCESSING.
MOVEI TRM,"!"
RET
;USERN
;INPUT USER/DIRECTORY NAME SUBR
;USED BY "LOGIN" AND "ATTACH".
;RETURNS STDIR'S RETURNED INFO IN A.
USERN: TLO Z,PUNCF ;ALLOW PUNCTUATION CHARS
CALL CSTR ;INPUT A FIELD
CALL BUFFF ;BUFFER IT RIGHT FOR JSYS, PUT PTR IN A
MOVE B,A
MOVE A,(B) ;GET FIRST PART OF DIR NAME
CAME A,[ASCII /DC-20/] ;IS THIS THE DATACOMPUTER?
JRST USERN2 ;NO
PUSH P,B ;YES
PUSH P,C
MOVE A,COJFN
GTTYP
TRZ B,1 ;SET TO CONTINUOUS-SCROLLING TERMINAL TYPE
STTYP
POP P,C
POP P,B
USERN2: SETZ A, ;NO RECOGNITION
STDIR ;STRING TO DIRECTORY # TRANSLATION
JRST CERR
CALL SCREWUP
ALTYPE ( )
RET
;CHECK TO SEE IF NEW LOGINS ARE BEING ALLOWED. TYPES MSG IF NOT AND
; RETURNS A NON-0 IF THAT IS THE CASE. IF LOGINS ARE OK, A RETURNED 0.
LGNCHK: MOVE 1,['LGNPAR']
CALL $SYSGT
SKIPN 1,2 ;SKIP IF IMPLEMENTED
RET ;0 SAYS "ALLOW LOGINS" TO CALLER
HRRZS 1 ;INDEX 0,,TABLE
GETAB
CALL JERR ;LOT'S OF LUCK IF THIS HAPPENS
SKIPN 2,1
RET ;0 SAYS OK
CALL CRIF
MOVEI 1,101
SETZ 3,
ERSTR
JFCL
JFCL
TYPE <: New logins not permitted
>
MOVE 1,2 ;RETURN ERROR CODE (IE NON-0)
RET
;ACCT ACCT0 ACCT1 ACCT2 ACCTX PIE.P PIEPX
REPEAT 0,<
;ACCT
;SUBROUTINE TO INPUT ACCOUNT STRING, CONVERT TO NUMBER IF
; REQUIRED AND RETURN IN A A SUITABLE ARGUMENT FOR LOGIN OR CACCT JSYS
;TAKES IN A: B1 ON FOR STRING ACCT, OFF FOR # (AS RETURNED BY "STDIR")
;USED IN ACCOUNT, CHANGE, LOGIN COMMANDS.
ACCT: PUSH P,B ;SAVE FOR CALLER
ACCT0: CALL CSTR ;COLLECT A STRING
ALLOW TSPC+TALT+TEOL
TLO Z,NEOLF ;DON'T ECHO EOL'S
PUSH P,A
CAIN CNT,1 ;JUST THE TERMINATOR INPUT?
JRST [ CALL DEFACT ;GET THE DEFAULT ACCOUNT FOR THIS USER
CAMN 1,[-1] ;IS THERE A DEFAULT?
JRST [ CALL DING ;NO
POP P,A ;GET BACK USER NUMBER
JRST MORE] ;BACK INTO CSTR
TRNE CBT,TALT ;ASKED FOR DEFAULT EXPLICTLY?
ETYPE <%1M> ;YES, TYPE IT OUT
ALTYPE ( )
SUB P,[1,,1]
JRST ACCTX]
ALTYPE ( )
TLNE A,B1
JRST [ CALL BUFFF ;STRING CASE. SAVE IN BUFFER.
JRST ACCT2] ;CHECK IT
ACCT1: TLO Z,BAKFF ;NUMERIC CASE. USE FIELD ALREADY INPUT.
CALL DECIN ;CONVERT
JRST CERR ;IT WAS NULL.
JUMPLE A,.+2
CAMLE A,[↑D999999]
JRST CERR ;OUT OF RANGE
TLO A,500000 ;SAY ITS NUMBER NOT STRING
ACCT2: POP P,B
CALL PIE.P ;SKIP IF PIE SLICE SYSTEM
SKIPN PRVENF ;SKIP IF ENABLED
CAIA
JRST ACCTX ;VERIFY IF NOT ENABLED ON PIE SLICE SYS.
EXCH A,B
VACCT
ERROR (Account invalid)
EXCH A,B
ACCTX: POP P,B
RET
;SKIP IF PIE SLICE CODE ON SYSTEM
PIE.P: PUSH P,1
PUSH P,2
MOVE 1,['GRPDES']
CALL $SYSGT
JUMPE 2,PIEPX
AOS -2(P)
PIEPX: POP P,2
POP P,1
RET
>
;DEFACT DEFA15 DEFAC2 DEFAC3
;ACCT ...
REPEAT 0,<
;GET DEFAULT ACCOUNT OF USER
; 1: USER DESIGNATOR
;RETURNS -1 OR ACCT DESIGNATOR IN AC1
DEFACT: MOVE B,A ;SAVE FOR GDACC
ADD P,[10,,10] ;ROOM FOR AN AC BLOCK
JUMPGE P,[SUB P,[10,,10] ;UNDO PDL OVF
PUSH P,[DEFACT+1] ;ERROR PC
JRST SCREWUP]
MOVSI A,-7+0(P)
HRRI A,-7+1(P)
SETZM -1(A)
BLT A,0(P) ;CLEAR THE BLOCK
MOVEI A,-7+0(P) ;WHERE TO STORE IT
GDACC ;GET DEFAULT ACCOUNT DESIGATOR
DEFA15: JRST [ SUB P,[10,,10]
SETOM A ;SAY DING NEEDED TO CALLER
RET]
DEFAC2: MOVE B,A ;FORM STRING PTR FOR BUFFS
HRLI B,(POINT 7,)
MOVEI CNT,↑D39 ;FOR BUFFS
LDB C,[POINT 3,A,2]
DEFAC3: CAIE C,5 ;NUMERIC MEANS DON'T BUFFER
CALL BUFFS ;MOVE ASCIZIFIED STRING TO BUFFER
SUB P,[10,,10]
RET
>
;PASWD
;PASWD
;SUBROUTINE TO INPUT PASSWORD FOR "LOGIN", "ATTACH", AND "CONNECT".
;HANDLES HALF AND FULL DUPLEX CASES.
;BUFFERS IT FOR USE AS A JSYS ARGUMENT AND RETURNS BYTE PTR IN A.
;CALLS "SPECEOL" AFTER IT.
;IF A=0, NO VALIDITY CHECK
;IF A<0, SPECIAL NOISE AND ALWAYS CHECK PASSWORD
;IF A>0, CHECKS VALIDITY FOR DIRECTORY # IN A IF NOT LOGGED IN.
PASWD: PUSH P,B
PUSH P,A
MOVE A,CIJFN
RFMOD ;READ TTY MODE
TRNE B,1B32 ;SKIP IF FULL DUPLEX
JRST PASWD1
;FULL DUPLEX CASE
;DON'T ECHO PASSWORD FIELD, DO ECHO TERMINATOR
;PASSWORD IS ACTUALLY INPUT IN CALL TO "NOISE" IF THERE IS NO
;NOISE WORD, OTHERWISE IN "CSTR".
CALL NOECHO ;TURN OFF ECHOING OF INPUT CHARACTERS
SKIPL 0(P)
NOISE <password> ;THIS CAN TURN ECHOING ON AGAIN
SKIPGE 0(P)
NOISE <from password>
CALL NOECHO ;MAKE SURE ITS OFF
TLO Z,PUNCF ;ALLOW "PUNCTUATION" CHARACTERS IN PASSWORD
TLZ Z,EOLNEF ;TELL CSTR THAT NOISE DIDN'T ECHO EOL
CALL CSTR ;(RE)READ PASSWORD STRING
PRINT (TRM) ;ECHO TERMINATOR
POP P,A ;0 OR GIVEN DIRECTORY #
CALL PSWDCK ;BUFFER PASSWORD AND CHECK IT
;A MUST BE PRESERVED FROM HERE TO RETURN
CALL DOECHO ;NOW WE WANT ECHOING ON
CALL SPECEOL ;CHECK TERMINATOR, ETC
ALTYPE ( )
JRST PASWD3 ;JOIN OTHER CASE
;PASWD1 PASWD3
;PASWD...
;HALF DUPLEX CASE
;USE SEPARATE LINE, TYPE MASK FIRST
;AS WITH FDX, PASSWORD IS READ BY "NOISE" IF NO (NOISE)
PASWD1: TRNE CBT,TLPR
JRST CERR ;DISALLOW ( AS USER NAME TERMINATOR
TRNN CBT,TEOL ;TYPE EOL UNLESS USER ENDED USER NAME WITH EOL
$TYPE <
>;
MOVEI TRM,"!" ;MAKES "NOISE" TYPE " (PASSWORD) "
SKIPL 0(P)
U$TYPE [ASCII / (password)
/ ;EXACTLY 3 WORDS (15 CHARS)
BYTE (7)130,130,130,130,130,130,130,130,15,40
BYTE (7)127,127,127,127,127,127,127,127,15,40
BYTE (7)115,115,115,115,115,115,115,115,15,40
BYTE (7)041,042,043,044,045,046,043,045,15,40,15,40,0]
;PASWORD MASK, OVERLAYED X, W, M, AND GARBAGE
SKIPGE 0(P)
U$TYPE [ASCII / (from passowrd)
/ ;EXACTLY 4 WORDS (20 CHARS)
BYTE (7)130,130,130,130,130,130,130,130,15,40
BYTE (7)127,127,127,127,127,127,127,127,15,40
BYTE (7)115,115,115,115,115,115,115,115,15,40
BYTE (7)041,042,043,044,045,046,043,045,15,40,15,40,0]
;PASWORD MASK, OVERLAYED X, W, M, AND GARBAGE
TLO Z,PUNCF
CALL CSTR ;INPUT PASSWORD
TRNE CBT,TLPR
JRST CERR ;DISALLOW ( HERE
PRINT CR ;SET TO OVERPRINT SAME LINE
TYPE <Thank you ... >
PRINT EOL
PRINT EOL
POP P,A
CALL PSWDCK ;BUFFER AND MAYBE CHECK PASSWORD
CALL SPECEOL
MOVEI TRM,"!" ;FORCES "NOISE" TO TYPE NEXT NOISE WD
PASWD3: POP P,B
RET
;PSWDCK PSWDC4 PSWDCX
;PSWDCK
;PASSWORD BUFFERER AND CHECKER USED AT TWO PLACES IN "PASWD".
;TAKES: A: 0 OR DIRECTORY #.
;RETS: B: BYTE PTR TO PASSWORD TEXT.
;PASSWORD MUST BE LAST FIELD CSTR'D.
PSWDCK: PUSH P,A
PUSH P,B
CALL BUFFF
MOVE BFP,.BFP ;FLUSH THE PASSWORD FIELD (↑R FIX)
MOVEI CNT,0 ;SAY CURRENT FIELD HAS NO CHR'S
MOVE B,A
EXCH A,-1(P) ;SAVE POINTER TO RETURN, GET DIRECTORY #
JUMPL A,PSWDC4 ;NEGATIVE, ALWAYS CHECK.
JUMPE A,PSWDCX ;NO DIR # GIVEN, NO CHECK.
SKIPLE CUSRNO ;IF LOGGED IN, NO CHECK.
JRST PSWDCX
PSWDC4: MOVMS A
TLO A,B0 ;SAY PASSWORD CHECK ONLY, NOT CONNECT.
CNDIR ;CHECK. ILLEGAL IF LOGGED IN.
JRST [ CAIN A,CNDIX1
JRST CERR ;BAD PASSWORD. "?" AND ABORT COMMAND.
CALL JERR] ;OTHER ERROR.
PSWDCX: POP P,B ;AVOID PAGE FAULTS IN MULTI-LINE LITS
POP P,A
RET
;MESMES MESMS9
;MESMES
;SUBROUTINE TO TYPE "YOU HAVE A MESSAGE" IF FLAG "MESMSF" IS ON AND
;THERE IS A MESSAGE FILE IN CONNECTED DIRECTORY.
;ALSO PRINTS SCHEDULED SHUTDOWN TIME, AND RESTART TIME, IF ANY.
;AND DISC ALLOCATION EXCEEDED MESSAGE.
;USED IN LOGIN, MAIN LOOP. CLOBBERS A,B,C.
MESMES: SKIPG CUSRNO
JRST MESMS9 ;IGNORE IF NOT LOGGED IN
CALL DWNTIM ;PRINT SHUTDOWN/RESTART TIMES
CALL CHKDAL ;NOTE OVER ALLOCATION IN PRESENT FIRST
MOVE A,CUSRNO ;GET USER NUMBER
CALL CHKMSG ;SKIP IF NEW MAIL EXISTS
JRST MESMS9
CALL CRIF ;ADJUST CARRIAGE IF NEEDED
TYPE <You have a message
>
MOVE A,COJFN
DOBE ;WAIT FOR IT TO REALLY PRINT
MESMS9: SETOM MSGTIM ;DISABLE "MAIL WATCH"
SETZM MESMSF ;CLEAR FLAG SO IT WONT BE REPEATED
RET
;DWNTIM DWNTI5 DWNTI9
;PRINT THE SCHEDULED SHUTDOWN TIME
;AND EXPECTED RESTART TIME.
;FOR LOGIN AND SYSTAT
DWNTIM: MOVE 1,['SYSTAT']
CALL $SYSGT
JUMPE 2,[RET] ;TABLE DOES NOT EXIST?
PUSH P,2 ;TABLE NUMBER
MOVSI 1,27 ;SHUTDOWN TIME CELL
HRR 1,2 ;TABLE NUMBER
GETAB
CALL JERR
JUMPE 1,[SUB P,[1,,1]
RET]
PUSH P,1
CALL CRIF
GTAD
ADD A,[2,,0]
CAMG A,(P)
JRST [SUB P,[2,,2]
RET]
TYPE <Tenex will go down >
MOVE 1,COJFN
POP P,2
MOVSI 3,(1B1+1B3+1B6+1B10+1B12+1B17)
ODTIM
MOVE 1,0(P) ;SYSTAT TABLE NUMBER
HRLI 1,30 ;RESTART TIME
GETAB
CALL JERR
JUMPE 1,DWNTI5 ;NO UPTIME DECLARED
PUSH P,1
TYPE < until >
MOVE 1,COJFN
POP P,2
MOVSI 3,(1B1+1B3+1B6+1B10+1B12+1B17)
ODTIM
DWNTI5: MOVE 1,0(P) ;SYSTAT TABLE #
HRLI 1,31 ;REASON FOR SHUTDOWN
GETAB
JRST DWNTI9 ;MAY HAPPEN ON OLD SYSTEMS
CAIN 1,5
TYPE <
due to preventive maintenance>
CAIN 1,6
TYPE <
due to scheduled hardware work>
CAIN 1,7
TYPE <
due to scheduled software work>
CAIN 1,8
TYPE <
due to emergency restart>
DWNTI9: SUB P,[1,,1]
SETOM DWNMSF ;SIGNAL DOWNTIME PRINTED SO DONT RECHECK
RET
;TRYGTJ TRYG9
;TRYGTJ
;TAKES: B: POINTER TO STRING FOR GTJFN
;RETS: +1: NO SUCH FILE
; +2: JFN IN A
;USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.
TRYGTJ: PUSH P,B
PUSH P,A
MOVSI 1,(1B2!1B17) ;SAY OLD FILE ONLY, SHORT GTJFN CALL
GTJFN ;ASSIGN JFN USING STRING POINTER IN B
CALL [ CAIE A,GJFX24 ;FAILURE. LOOK AT CODE. "NO NEW FILES"
CAIN A,GJFX18 ;"NO SUCH NAME"
JRST [ SUB P,[1,,1]
POP P,A
JRST TRYG9]
CAIE A,GJFX19 ;"NO SUCH EXTENSION"
CAIN A,GJFX20 ;"NO SUCH VERSION"
JRST [ SUB P,[1,,1]
POP P,A
JRST TRYG9]
CAIN A,GJFX35
ERROR <Directory protected>
JRST JERR]
MOVE B,JBUFP ;SAVE JFN IN JFN STACK, SO IT WILL BE
PUSH B,A ;RELEASED ON ↑C OR ERROR
MOVEM B,JBUFP ;..
SUB P,[1,,1] ;FORGET SAVED A
AOS -1(P) ;SKIP
TRYG9: POP P,B
RET
;MESS MESS2 MESS3 MESS4 MESS7 MESS8 MESS9
;MESS
;SUBROUTINE TO PRINT MESSAGE FROM A GIVEN FILE, IF FILE EXISTS.
;SLOW NOP IF FILE DOES NOT EXIST.
;TAKES: A: A DATE & TIME. FILE PRINTED IF NEWER THAN THIS.
; TYPICALLY, THIS IS THE LAST LOGIN TIME.
; B: STRING POINTER TO FILE NAME. CLOBBERS B.
;7/3/70: ONLY ONE CALL, IN "LOGIN"
MESS: PUSH P,C
PUSH P,A ;SAVE CONVERTED GIVEN DATE & TIME
CALL TRYGTJ ;ASSIGN A JFN TO FILE NAMED BY STRING
JRST MESS9 ;NO SUCH FILE
PUSH P,A ;MESSAGE FILE JFN
MOVE B,[1,,FDBWRT]
MOVEI C,C
GTFDB ;GET WRITE DATE & TIME FROM FILE
CAMGE C,-1(P) ;COMPARE TO GIVEN
JRST MESS8 ;NO NEED TO PRINT IT
MESS2: MOVE A,-1(P)
PUSH P,A ;A COPY OF DATE
MOVE A,COJFN ;JFN FOR OUTPUT
TLO A,(1B1) ;NO STATIC IF NO SYSTEM MSG
PUSH P,A
MOVEI 1,400000 ;THIS FORK
RPCAP
MOVEI 1,CTRLC ;↑C TERMINAL CODE
TLNE 3,(1B0) ;IF ↑C CAP ENABLED
DTI ;TURN OFF ↑C
MOVEI A,0 ;NO SPECIAL CAPS.
CFORK
CALL [ INTON
JRST JERR]
PUSH P,1 ;FORK HANDLE
MOVSI 1,(1B2+1B17) ;OLD, SHORT
HRROI 2,[ASCIZ /<SUBSYS>READMAIL.SAV/]
GTJFN
JRST MESS4 ;READMAIL NOT AVAILABLE
MESS3: HRL 1,0(P) ;MAKE FORK.JFN
GET ;AND RELEASE READMAIL JFN
MOVE 1,0(P) ;FORK HANDLE
MOVEI 2,-4(P) ;WHERE GOODIES ARE
SFACS ;FROM ON THE STACK
GEVEC
MOVEI 2,1(2) ;REENTER ADDR, EVEN IF OLD EV
SFORK
WFORK
MESS4: POP P,1 ;FORK HANDLE
KFORK
MESS7: MOVEI 1,400000
RPCAP
MOVE 1,[CTRLC,,1] ;↑C ON CHANNEL 1
TLNE 3,(1B0) ;IF THIS FORK HAS ↑C CAP ENABLED
ATI ;ALLOW ↑C AGAIN
POP P,1 ;JUNK (COJFN)
POP P,1 ;JUNK (COPY OF DATE)
MESS8: POP P,1 ;MESSAGE FILE JFN
RLJFN
CALL JERR
MESS9: POP P,A ;FROM CALLER
POP P,C ; "
RET
;.KKJOB .LOGOU LOGOU1 LOGO14 LOGOU2 LOGOU3
;KKJOB
.KKJOB: HRROI A,[ASCIZ/Bye
/]
PSOUT
DTACH
SETO A,
LGOUT
CALL JERR
;LOGOUT
.LOGOU: TRNN CBT,TEOL ;STANDARD CASE IF EOL TERMINATED
SKIPG CUSRNO ;LOGGED IN?
JRST LOGOU1 ;NO, ONLY ONE CASE
INHELP <
EOL or job number>
ALLOW TEOL+TSPC+TALT
TLO Z,BAKFF
CALL DECIN ;TRY TO READ JOB NUMBER
JRST LOGOU1 ;NO NUMBER, LOGOUT THIS JOB
JRST ..LOGO ;LOGOUT ANOTHER JOB
LOGOU1: CALL INFER ;SKIP IF INFERIOR
JRST LOGO14
; MOVEI 1,400000 ;INFERIOR, GET CAPABILITIES
; RPCAP
; TLNN 2,(1B3) ;"LOG" CAPABILITY? (CHECK THIS←←←)
; ERROR <Not legal in inferior EXEC>
TYPE < [Inferior EXEC]>
TLO KWV1,CONMAN ;REQUIRE CONFIRMATION
LOGO14: CONFIRM
MOVEI 1,HUCODE ;"HANG UP" INTERRUPT CODE
DTI ;↑C AND ERRORS ATI AT CMDN2D
SKIPG CUSRNO ;NOW LOGGED IN?
JRST LOGOU3 ;NO, NO EXPUNGE OR CHKDAL
LOGOU2: GJINF
MOVE 1,2 ;CONNECTED DIRECTORY
; DELDF ;"EXPUNGE"
CALL CHKDAL ;YES, NOTE OVER ALLOC IF PRESENT
CALL JOBCNT ;PRINT OTHER JOBS OF THIS USER
GJINF
PUSH P,A
CNDIR ;CONNECT TO LOGIN DIRECTORY
JFCL
POP P,A
CALL CHKMSG
JRST LOGOU3 ;NO NEW MSGS
TYPE < You have unread messages, please reconfirm logout.>
TRZ CBT,TEOL ;MAKE CONFIRM TYPE <CR>
TLZ KWV1,NOCONF+ALTCON
TLO KWV1,CONMAN
CONFIRM
LOGOU3: TLO Z,LOGOFF ;SAY LOGGING OUT (TELLS ERROR AND ↑C
;ROUTINES TO SAY "NOT LOGGED OUT").
MOVE A,COJFN
DOBE ;WAIT TO GIVE HIM MAXIMUM CHANCE TO ↑C.
CALL RESET
; CALL BREAK2 ;DO "BREAK" AND "REFUSE"
HRLOI A,(1B0+1B1)
MOVEI 2,-1
TLINK ;BREAK ALL TTY LINKS
JFCL
SETO A, ;SAY ITS SUICIDE
LGOUT
CALL JERR
;BETTER NOT RETURN IF SUCCESSFUL
;JOBCNT JOBCN1 JOBCN2 JOBCN8 JOBC84 JOBCN9 JOBCNX
;COUNT JOBS LOGGED IN UNDER THIS USER'S DIRECTORY
;IF MORE THAN ONE, PRINT INFORMATIVE MESSAGE
JOBCNT: GJINF
MOVE E,A ;LOGIN DIRECTORY #
SETO D, ;GET LENGTH OF 'JOBDIR' GETAB
GTB 3 ;WHICH IS CONN#,,LOGIN# [JOB#]
HRLZ D,A ;SET UP LENTH,,INDEX FOR AOBJN & GTB.
SETZB F,G ;INIT TOTAL AND DET COUNTS
JOBCN1: GTB 3 ;JOBDIR(D) TO A
CAIE E,0(A) ;ONE OF THIS USER'S JOBS?
JRST JOBCN8 ;NO, TRY NEXT
JOBCN2: GTB 0 ;JOBPT(D) TO A
SKIPGE A ;SKIP IF NOT DETACHED
ADDI G,1 ;INCREMENT DET COUNT
ADDI F,1 ;INCREMENT TOTAL COUNT
JOBCN8: AOBJN D,JOBCN1 ;CHECK ALL JOBS
CAIG F,1 ;MORE THAN JUST THIS JOB?
JRST JOBCNX ;NO. DONE
SUBI F,1 ;REDUCE TO NUMBER OF OTHER JOBS
CALL CRIF ;TYPE CARRIAGE RETURN IF NEEDED
CAIN F,1
JRST JOBC84
ETYPE <[%5R has %6Q other jobs>
SKIPE G ;CHECK DET COUNT
ETYPE <, %7Q detached>
PRINT "]"
JRST JOBCN9
JOBC84: SKIPN G ;ONE OTHER JOB, HOW MANY DETACHED?
ETYPE <[%5R has one other job]>
SKIPE G
ETYPE <[%5R has a detached job]>
JOBCN9: PRINT EOL
JOBCNX: RET
;.MAIL $MAIL M..CHK M..WAT $M.WAT M.WA.F M.WA.N
;"MAIL"
.MAIL: KEYWD $MAIL
0
JRST CERR
JRST 0(KWV)
$MAIL: TABLE
T CHECK,EOLOK,M..CHK
T WATCH,,M..WAT
TEND
M..CHK: NOISE <for user>
TLO Z,NEOLF ;SUPPRESS ECHO OF EOL
CALL DEFDIR ;INPUT A USER NAME TO A
;(NEAR PRINTER CHECK)
PUSH P,A
ALLOW TSPC+TALT+TEOL
CONFIRM
CALL CRIF
POP P,A
CALL CHKMSG ;FOR USER # IN A
TYPE <No >
TYPE <New mail exists>
RET
;"MAIL WATCH ON/OFF"
M..WAT: KEYWD $M.WAT
TE ON,,M.WA.N
JRST CERR
JRST 0(KWV)
$M.WAT: TABLE
TE OFF,,M.WA.F
TE ON,,M.WA.N
TEND
M.WA.F: ALLOW TSPC!TALT!TEOL
ALTYPE ( )
CONFIRM
SETOM MSGTIM
RET
M.WA.N: ALLOW TSPC+TALT+TEOL
ALTYPE ( )
CONFIRM
SETZM MSGTIM
RET
;CHKMSG CHKMS4 CHKMS9
;CHKMSG
;SKIPS IF NEW MAIL EXISTS FOR USER # SUPPLIED IN A
;USED IN MAIN LOOP, LOGIN, AND MAIL COMMANDS
CHKMSG: PUSH P,A
PUSH P,B
PUSH P,C
HRROI A,CSBUF ;POINTER TO STRING AREA BEGINNING
MOVEI B,"<" ;FORM <USER>MESSAGE.TXT
BOUT
MOVE B,-2(P) ;USER #
DIRST
CALL JERR
HRROI B,[ASCIZ />MESSAGE.TXT;1/]
SETZ C,
SOUT
HRROI B,CSBUF
CALL TRYGTJ ;GET JFN AND STACK IT FOR RELEASE
JRST CHKMS9 ;GIVE NO SKIP RETURN
MOVE B,[2,,FDBWRT] ;WRITE AND READ DATES
MOVEI C,B ;TO B AND C
GTFDB
CAMG B,C ;WRITTEN MORE RECENTLY THAN READ?
JRST [ MOVEI C,0 ;NO, FORCE NO TYPEOUT
JRST CHKMS4]
MOVE B,[1,,FDBSIZ]
MOVEI C,C
GTFDB ;GET # BYTES IN FILE
CHKMS4: RLJFN ;GET RID OF JFN
CALL JERR
MOVN A,[1,,1] ;REMOVE FROM STACK TOO
ADDB A,JBUFP
SETOM 1(A)
JUMPLE C,CHKMS9 ;NO MSG IF FILE IS NULL
AOS -3(P) ;ARRANGE FOR SKIP RET
CHKMS9: POP P,C
POP P,B
POP P,A
RET
;.MOUNT
;"MERGE" IS WITH "GET" ABOVE.
;MOUNT <DEVICE>
.MOUNT: CALL DEVN
TLNN B,B7
ERROR <%1H: not a mountable device>
TLNN B,B5
JRST [ TLNN B,B6
UERR [ASCIZ /%1H: not available/]
UERR [ASCIZ /%1H: assigned to job %3Q/]]
CONFIRM
MOUNT ;NO ERROR IF ALREADY MOUNTED.
CALL JERR
RET
;.NO $NO
;"NO" PREFIX
;THE "NO" PREFIXED VERSIONS GO THRU THE SAME ROUTINES AS THE UNPREFIXED
;VERSIONS, BUT WITH F1 SET WHICH REVERSES THE EFFECT OF THE SUBROUTINES
;THEY CALL. F1 IS CLEAR ON DISPATCH FROM THE MAIN LOOP.
.NO: KEYWD $NO ;"NO". LOOK UP NEXT WORD.
TE EXEC
JRST CERR ;NULL ILLEGAL
CONFIRM
TLO Z,F1 ;SAY NO
JRST (KWV) ;GO TO .FORMF, .TABS, OR .LOWER.
$NO: TABLE
; TE BDDT
TE EXEC
TE FORMFEED
TE IDDT
TE INDICATE
TE LOWERCASE
TE RAISE
TE SHOW
TE TABS
TEND
;.NOT $NOT
;"NOT" COMMAND PREFIX
.NOT: KEYWD $NOT
T EPHEMERAL,LANOK+LPROK,.NOTEP
JRST CERR ;NULL NOT ACCEPTABLE
JRST (KWV) ;OFF TO ROUTINE
$NOT: TABLE
T EPHEMERAL,LANOK+LPROK,.NOTEP
; T PERPETUAL,LANOK+LPROK,.NOTPE
TEND
;.NUMBE
;"NUMBER (OF DIRECTORY) <NAME>"
;RETURNS DIRECTORY NUMBER (FOR 10/50 PPN'S AND KNOWING WHICH DIR TO MAP)
.NUMBE: NOISE <of directory>
CALL DIRNAM ;INPUT DIRECTORY NAME WITH RECOGNITION
ALTYPE ( )
ALLOW TEOL+TSPC+TALT ;CHECK TERMINATOR
CONFIRM ;MUST ALWAYS DO THIS
ETYPE ( Directory number %1P)
RET
;.NOTPE .PERPE PERPE0
;"PERPETUAL <FILE LIST>" AND "NOT PERPETUAL <FILE LIST>"
REPEAT 0,<
;SETS OR CLEARS FDBUND BIT IN FDBCTL
.NOTPE: HRLI B,-2 ;DEFAULT VERSION TO LOWEST
TLOA Z,F1 ;REMEMBER "NOT"
.PERPE: HRLI B,0 ;DEFAULT VERSION IS HIGHEST
NOISE <files>
MOVE A,[2,,2] ;SAY DEFAULT NAME AND EXT TO PREVIOUS
HRRI B,B2+B11+B15+B16 ;OLD FILE, *'S, COMMA OK
CALL SPECFN ;INPUT FILE NAME DESCRIPTOR
JRST CERR
ALLOW TSPC+TALT+TEOL
CONFIRM
CALL FRSTF ;TYPE NAME IF A GROUP
PERPE0: HRRZ A,@INIFH1 ;JFN
DVCHR
TLNN B,(1B4) ;DISK?
JRST [ UTYPE [ASCIZ / not a disk file/]
JRST NEXTF]
HRRZ A,@INIFH1 ;JFN
HRLI A,FDBCTL
MOVSI B,(FDBUND) ;CHANGE "UNDELETABLE" BIT
TLNE Z,F1 ;"NOT PERP" ?
TDZA C,C ;YES, CLEAR THE BIT
MOVSI C,(FDBUND)
CHFDB
JRST NEXTF ;GET NEXT FILE, RET TO PERPE0
>
;.PRNTR $PRNTR P..CHK P..WAT $P.WAT P.WA.F P.WA.N DEFDIR DEFDI1
;"PRINTER"
REPEAT 0,<
.PRNTR: KEYWD $PRNTR
0
JRST CERR
JRST 0(KWV)
$PRNTR: TABLE
T CHECK,EOLOK,P..CHK
T WATCH,,P..WAT
TEND
P..CHK: NOISE <for user>
TLO Z,NEOLF ;SUPPRESS ECHO OF EOL
CALL DEFDIR ;INPUT DIRECTORY NAME WITH RECOG
PUSH P,A ;SAVE IT
ALLOW TSPC!TALT!TEOL
CONFIRM
CALL CRIF
TYPE <Printing>
POP P,A
CALL CHKPRN ;CHECK PRINTER FOR USER IN A
TYPE < not>
TYPE < in progress>
RET
;"PRINTER WATCH ON/OFF"
P..WAT: KEYWD $P.WAT
TE ON,,P.WA.N
JRST CERR
JRST 0(KWV)
$P.WAT: TABLE
TE OFF,,P.WA.F
TE ON,,P.WA.N
TEND
P.WA.F: ALLOW TSPC!TALT!TEOL
ALTYPE ( )
CONFIRM
SETOM PRNTIM
RET
P.WA.N: ALLOW TSPC!TALT!TEOL
ALTYPE ( )
CONFIRM
SETZM PRNTIM
RET
>;REPEAT 0
;INPUT OR DEFAULT DIRECTORY NAME
; USED BY "MAIL CHECK" AND "PRINTER CHECK"
DEFDIR: TLNE Z,BAKFF ;IS THERE AN UN-INPUT FIELD?
JRST DEFDI1 ;YES. USE DIRNAM TO READ IT
TRNE CBT,TEOL ;NO. EOL TERMINATED PREVIOUS FIELD?
SKIPA A,CUSRNO ;YES. USE LOGIN DIRECTORY (IF ANY)
DEFDI1: CALL DIRNAM ;INPUT A DIRECTORY NUMBER TO A
ALTYPE ( )
SKIPG A ;IS HE LOGGED IN?
ERROR <You are not logged in>
RET
;CHKPRN CHKPR1 CHKPRX
;CHECK PRINTER ROUTINE
REPEAT 0,<
;CALLED FROM MAIN LOOP WITH USER NUMBER IN 1
;SKIPS IF A FILE(S) <PRINTER>LPT.USER;* EXISTS
CHKPRN: PUSH P,1
PUSH P,2
PUSH P,3
HRROI 1,CSBUF ;STRING BUFFER AREA
HRROI 2,[ASCIZ /<PRINTER>LPT./]
SETZ 3,
SOUT
HRRZ 2,-2(P) ;USER #
DIRST
CALL [ SETOM PRNTIM ;CANCEL THE WATCH
JRST JERR]
CHKPR1: MOVSI 1,(1B2!1B17) ;OLD, SHORT
HRROI 2,CSBUF
GTJFN
JRST CHKPRX ;NONE THERE. NO SKIP.
RLJFN
CALL JERR
AOS -3(P) ;ARRANGE FOR SKIP RETURN
CHKPRX: POP P,3
POP P,2
POP P,1
RET
>;REPEAT 0
;.QUIT QUIT1 QUIT2
;QUIT: EXIT TO SUPERIOR EXEC OR OTHER PROGRAM.
;IF TOP-LEVEL FORK, LEGAL ONLY FOR ENABLED WHEELS OR OPERS.
.QUIT: CALL INFER ;SKIP IF INFERIOR
JRST [ HRLZI B,WHLUO+OPRUO
SKIPE PRVENF
CALL PRVCK
UERR [ASCIZ /Not legal in top-level EXEC/]
JRST QUIT1] ;DON'T DISABLE ↑C AT TOP LEVEL
;DEASSIGN SUPER-PANIC PSI CHARACTER ↑C
;IF POSSIBLE, TEST WHETHER ASSIGNED TO THIS FORK ←←←←←←←
;MEANWHILE, JUST TEST SPEC CAP
MOVEI A,B0
RPCAP ;GETS ENABLED CAPS IN C
MOVEI A,CTRLC
TLNE C,B0
DTI ;DEASSIGN TERMINAL INTERRUPT
QUIT1: MOVEI A,CTCODE ;CHAR THAT PRINTS RUNTIME (↑T)
DTI
MOVEI A,HUCODE ;DATAPHONE HANGUP CODE
DTI
MOVEI E,PTTYMD ;PASS BACK TTY LEFT BY PROGRAM
CALL LTTYMD
QUIT2: CALL INFER ;SKIP IF INFERIOR EXEC
JRST [ JSYS 777 ;CALL MINI-EXEC
JRST REE] ;AFTER ↑ TO MINI-EXEC
MOVE 1,SUPSUB
SETNM ;BUT RESTORE SUPERIOR'S SUBSYS
HALTF
JRST REE ;AFTER CONTINUE FROM SUPERIOR EXEC
;INFER INFER0 INFER1 INFER3 INFRS INFER6 INFER9
;INFERIORNESS TEST SUBROUTINE: SKIP IF THIS FORK HAS A SUPERIOR
;USED IN LOGOUT, QUIT, ↑E EDDT.
INFER: PUSH P,A
PUSH P,B
INFER0: MOVEI A,INFER3 ;SET TO CATCH TRAPS FROM GFRKH
MOVEM A,ILIDSP ;ON MONITORS WITHOUT IT (BEFORE 1.31)
INFER1: MOVEI 2,400000 ;SELF
MOVNI 1,1 ;RELATIVE TO SUPERIOR
GFRKH ;GET FORK HANDLE
JRST INFER3 ;NO MORE HANDLES, OLD MONITOR, ETC
SETZM ILIDSP ;NOT INTERESTED IN ILLEGAL INSTRS NOW
CAIN 1,400000 ;SELF MEANS WE ARE TOP FORK
JRST INFER6 ;SO GIVE SKIP RETURN
RFRKH
JRST INFER9 ;GIVE SKIP
INFER3: SETZM ILIDSP ;NO LONGER INTERESTED IN ILLEGAL INSTRS.
MOVEI A,-1 ;SUPERIOR FORK HANDLE
INFRS: RFSTS
CAMN A,[-1]
INFER6: JRST [ POP P,B ;SUPERIOR HANDLE INVALID
POP P,A ;MEANS NO SUPERIOR.
RET]
;BUT RFSTS MAY RETURN THIS FORK'S STATUS IF NO SUPERIOR.
;ASSUME IT IS SELF (AND NO SUPERIOR) IF PC RETURNED
; IS THAT WHERE RFSTS IS.
MOVEI B,(B) ;MASK PC
CAIE B,INFRS+1
INFER9: AOS -2(P) ;DIFFERENT, WE HAVE A SUPERIOR
JRST [ POP P,B
POP P,A
RET]
;.PROTE
;PROTECTION (OF FILE) <EXISTING NAME> (IS) <18 BIT OCTAL>
.PROTE: NOISE <of file>
HRROI A,
CALL CINFN
JRST CERR
ALLOW TSPC+TALT+TLPR
NOISE <is>
CALL OCTCOM ;OCTAL INPUT TO A. ALLOWS LH,,RH ETC.
JRST CERR ;NULL - NO DEFAULT.
TLNE A,-1
ERROR <Left half must be 0> ;ONLY NUMERIC PROTECTIONS NOW
;OCTCOM CHECKS TERMINATOR.
TRNN A,1B22
ERROR < You can't make protection invisible (20000-BIT)>
CONFIRM
TLO A,500000 ;SAY THERE'S 18-BIT PROTECTION IN RH
PUSH P,A
MOVE A,CJFN1
DVCHR
TLNN B,B4 ;MULTIPLE DIRECTORY DEVICE?
ERROR <%1H: doesn't have protected files>
MOVE A,CJFN1
POP P,C
HRLI A,FDBPRT ;PROTECTION WORD IN FDB
MOVEI B,-1 ;CHANGE RH
CHFDB ;THIS COULD ITRAP, SHOULD BE PROTECTED
JRST RLJFNS
;THE FOLLOWING SHOULD REPLACE THE ABOVE IF CPRTF IS EVER IMPLEMENTED
REPEAT 0,<
CPRTF ;CHANGE PROTECTION OF FILE
CALL [ CAIN A,CPRTX1
ERROR <Protection of %1S is protected from you>
JRST JERR]
JRST RLJFNS ;RELEASE JFNS AND POPJ TO CMDIN4.
>
;.RECEI $RECTB ..ADVZ ..LINK
;RECEIVE
.RECEI: KEYWD $RECTB
T LINKS,EOLOK,..LINK
JRST CERR
JRST (KWV)
$RECTB: TABLE
; T ADVICE,EOLOK+LPROK,..ADVZ
T LINKS,EOLOK,..LINK
TEND
REPEAT 0,<
..ADVZ: NOISE <from>
CALL TTYNUM
MOVEI 1,400000(1) ;FORM TTY DESIGNATOR
TLO 1,(1B2) ;SET "ACCEPT" ADVICE FLAG
ADVIZ
CALL [ CAIN 1,ADVX2
ERROR <Ignored>
CAIN 1,ADVX4
ERROR <Advice already in progress>
JRST JERR]
RET
>
..LINK: CONFIRM
INTOFF ;BE SURE BOTH ADVISE AND TLINK HAPPEN
HRLOI 1,(1B4+1B5)
TLINK
CALL [ INTON
JRST JERR]
REPEAT 0,<
MOVSI 1,(1B0) ;BREAK "ADVISE" LINK
ADVIZ
CALL [ INTON
JRST JERR]
>
INTON
RET
;$REENT .REENT ..REEN
;REENTER
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH
$REENT: SKIPGE A,FORK
ERROR <No program>
GEVEC
HLRZ B,B
CAIE B,<JRST>B53
JRST [ CAIGE B,2 ;LONG ENOUGH TO HAVE REENTER?
UERR [ASCIZ /No reenter address/]
RET]
MOVEI A,.JBREN ;COMPATIBLE CASE CHECK
CALL MAPPF
TLNN A,B5
ERROR <No page 0>
TLNN A,B2
ERROR <Page 0 read-protected>
MOVEI A,.JBREN
HRRZ A,PAGEN(A)
JUMPE A,[UERR [ASCIZ /No reenter address/]]
RET
;REENTER COMMAND DISPATCHES HERE
.REENT: CALL $REENT
CONFIRM
;REDIRET/DETACH...(AND) REENTER JOINS HERE
..REEN: MOVNI B,2 ;REENTER CODE FOR PA1050
CALL CHKPAT ;SETUP PA1050 IF THERE
MOVEI E,PTTYMD ;SET TTY MODES TO PROGRAM'S
CALL LTTYMD ;.. (EXEC'S MODES NEEDN'T BE STORED)
JUMPG B,.+2 ;PA1050 START IF POSITIVE
MOVEI B,1 ;ENTRY VECTOR INDEX 1 FOR REENTER
JRST START2 ;JOIN START COMMAND
;.REFUS
;REFUSE (LINKS)
; REFUSES BOTH ORDINARY LINKS AND ADVISE LINKS
.REFUS: NOISE <links>
CONFIRM
INTOFF ;BE SURE BOTH HAPPEN
HRLOI A,(1B4) ;CHANGE ACCEPT BIT TO 0
TLINK
CALL JERR
REPEAT 0,<
MOVSI 1,(1B0) ;"BREAK"
ADVIZ
CALL JERR
>
INTON
RET
;.RENAM
;RENAME (EXISTING FILE) <NAME> (TO BE) <NAME>
.RENAM: NOISE <existing file>
HRROI A, ;SAY NO DEFAULT EXTENSION
CALL CINFN ;GET INPUT FILE NAME
JRST CERR ;NO DEFAULT IF USER TYPES "-"
ALLOW TSPC+TALT+TLPR
NOISE <to be>
MOVE A,[2,,2] ;SAY DEFAULT NAME AND EXT TO THOSE OF FIRST FILE
CALL COUTFN ;OUTPUT FILE NAME, OLD OR NEW.
JRST CERR
CONFIRM
MOVE A,CJFN1 ;EXISTING FILE JFN
MOVE B,CJFN2 ;NEW FILE JFN
RNAMF ;RENAME FILE
CALL [ CAIN A,RNAMX1
ERROR <Files not on same device>
CAIN A,RNAMX4
ERROR <No room>
CAIN A,RNAMX5
ERROR <Destination busy>
CAIN A,RNAMX8
ERROR <No access to source>
CAIN A,RNMX10
ERROR <Source is in use>
CAIN A,RNMX12
ERROR <Rename to self is illegal>
JRST JERR]
JRST RLJFNS ;RELEASE THE JFNS
;.RESET RESET RESET2 RESE25 RESET3 RESE30 RESE31 RESE32 RESET4
;RESET
.RESET: INTOFF
SKIPL A,XFORK
KFORK
SETOM XFORK
;GET AND EDIT USE THE FOLLOWING AS A SUBROUTINE
RESET: INTOFF
RESET2: SETOM A
CALL MAPPF ;UNMAP ANY PAGE
CALL UNMAP ;INCLUDING BUFFER PAGES, ETC
; MOVEI 1,-4
; KFORK ;KILL ALL INFERIORS
; DO NOT WANT TO KILL XFORK
SKIPL A,EFORK ;KILL EPHEMERAL FORK IF STILL AROUND
KFORK
SETOM EFORK
SKIPGE A,IDFORK
SKIPL A,FORK
KFORK
SETOM UFORK
SETOM IDFORK
; SETOM BDFORK
SETOM LRFORK ;SAY THERE'S NO INFERIOR THAT'S BEEN RUN
SETOM FORK ;SAY EXEC IS NOT POINTED AT ANY FORK
SETZM PROPSF ;SAY THERE'S NO PROPRIETARY SUBSYSTEM
SETZM DDTFLG ;SAY THERE'S NO DDT IN FORK
RESE25: MOVEI 1,400001 ;SCAN THROUGH ALL POSSIBLE HANDLES
CAME A,XFORK ;NOT THE EXEC FORK
RFRKH ;RELEASING THEM
CAIGE 1,400017 ;DID WE JUST DO THE LAST ONE?
AOJA 1,.-3 ;NO, DO ANOTHER
RESET3: SKIPG CREDIF ;ABANDONED PRIMARY INPUT FILE?
JRST RESE31 ;NO
HRRZ 1,CRJFNI
GTSTS
TLNN 2,(1B10)
JRST RESE30 ;BAD JFN, FORGET IT
TLNN B,(1B0)
JRST [ RLJFN ;NOT OPEN, JUST RELEASE IT
CALL JERR
JRST RESE30]
CLOSF
CALL JERR
RESE30: SETZM CREDIF ;SAY INPUT NO LONGER REDIRECTED
RESE31: SKIPG CREDOF
JRST RESET4
HRRZ 1,CRJFNO
GTSTS
TLNN 2,(1B10)
JRST RESE32
TLNN 2,(1B0)
JRST [ RLJFN
CALL JERR
JRST RESE32]
CLOSF
CALL JERR
RESE32: SETZM CREDOF
;CLOSE ALL FILES OF INTERIOR FORKS
;AFTER KILLING FORKS, TO GET SHARED FILE JFN'S!
RESET4: HRLI A,B1 ;DON'T CLOSE THIS FORK'S FILES
HRRI A,B0 ;SELF
CLZFF
INTON
RET
;"RUN" IS WITH "GET" ABOVE
;.SAVE SAVE1
;SAVE (CORE FROM) N (TO) N, (FROM) N (TO) N ... (ON) F
.SAVE: SKIPGE FORK
ERROR <No program>
NOISE <core from>
MOVEI B,1(P) ;WHERE "SAVE" ARGUMENT TABLE WILL BEGIN
SAVE1: CALL OCTAL ;INPUT OCTAL NUMBER AND SKIP
JRST [ALLOW TALT ;NO SKIP, NULL INPUT.
MOVEI A,20 ;ON ALT MODE GNLY, ASSUME 20.
U$TYPE [ASCIZ /20 /]
JRST .+1]
ALLOW TSPC+TALT+TLPR
PUSH P,A ;BUILD TABLE OF "SAVE" ARGUMENTS IN PUSHDOWN
NOISE <to>
CALL OCTAL
JRST [ALLOW TALT
MOVEI A,-1
U$TYPE [ASCIZ /777777 /]
JRST .+1]
SUB A,(P)
JUMPL A,CERR ;MAX < MIN
ADDI A,1
TLNE A,1
JRST [ MOVEI A,1B18 ;FOR 0 TO 777777 LENGTH IS 1000000,
HRLM A,(P) ;...WHICH IS MORE THAN 18 BITS,
PUSH P,[B0,,B0] ;...SO USE TWO BLOCKS OF HALF SIZE.
JRST .+2]
HRLM A,(P) ;FORM LENGTH,,LOCATION
CAIN TRM,"," ;COMMA AFTER SECOND ONE?
JRST [CALL SAVNOI ;SPECIAL HANDLING OF NOISE "FROM"
JRST SAVE1] ;GET ANOTHER PAIR
ALLOW TSPC+TALT+TLPR+TLAN
NOISE <on>
TLZ Z,EOLNEF ;EOL JUST TRIGGERED [NEW FILE]
HRROI A,[ASCIZ /SAV/] ;DEFAULT .SAV, NO NULL CASE.
CALL COUTFN ;COLLECT OUTPUT FILE NAME
JRST CERR
CONFIRM
;TRANSFER DATA
PUSH P,[0] ;TERMINATE TABLE
HRL A,FORK
HRR A,CJFN1
;B ALREADY CONTAINS POINTER TO TABLE
SAVE ;SAVE. IGNORES NON-EXISTENT OR 0 CORE.
CALL RLJFNS ;RELEASE JFN.
JRST CMDIN4 ;CAN'T POPJ WITHOUT FLUSHING TABLE
;SAVNOI SAVNO1
;SAVNOI
;SUBROUTINE FOR SPECIAL HANDLING OF NOISE WORD "(FROM)" AFTER COMMA
; IN SAVE AND SSAVE COMMANDS:
;IF NEXT INPUT IS ALT MODE, TYPE OUT THE NOISE WORD.
;THIS IS BECAUSE PREVIOUS FIELD CAN'T END WITH ALT MODE -
; ALT MODE MEANS SOMETHING DIFFERENT IN THIS CONTEXT.
SAVNOI: PRINT " " ;SOME INDICATION THAT COMMA WAS ACCEPTED
CALL CSTR ;PRE-READ NEXT FIELD
TLO Z,BAKFF ;SAY RE-USE IT
TRNN CBT,TALT ;DID IT END IN ALT MODE?
JRST SAVNO1 ;NO, MIGHT BE "(", IN WHICH CASE "NOISE" MACRO
;WILL ALLOW USER TO TYPE IN NOISE WORD.
CAILE CNT,1 ;WAS IT NULL?
RET ;NO, ITS NEXT ARG, NO "NOISE" MACRO NEEDED.
TLZ Z,BAKFF ;ALT MODE ONLY, DON'T RE-USE, "NOISE" MACRO
;WILL TYPE OUT NOISE.
SAVNO1: NOISE (from)
RET
;.SHUT
;SHUT (ALL OPEN FILES)
.SHUT: NOISE <all open files>
CONFIRM
;CLOSE ALL FILES BELONGING TO FORKS INFERIOR TO THIS EXEC.
HRLI A,B1 ;SAY DON'T CLOSE MY FILES
HRRI A,B0 ;SAY ME
CLZFF
RET
;.SSAVE SSAV1
;SSAVE (PAGES FROM) N (TO) N, (FROM) N (TO) N ... (ON) FILE
;SHARABLE SAVE, WITH READ-EXECUTE PAGE ACCESS.
;CODING SIMILAR TO "SAVE", SEE ITS COMMENTS.
;SHOULD WE CHECK THAT PAGES EXIST?
.SSAVE: SKIPGE FORK
ERROR <No program>
NOISE <pages from>
MOVEI B,1(P) ;WHERE TABLE WILL BEGIN IN PUSHDOWN
SSAV1: CALL OCTAL
JRST [ ALLOW TALT
MOVEI A,0
U$TYPE [ASCIZ /0 /]
JRST .+1]
ALLOW TSPC+TALT+TLPR
CAILE A,777
JRST CERR
PUSH P,A
NOISE (to)
CALL OCTAL
JRST [ ALLOW TALT
MOVEI A,777
U$TYPE [ASCIZ /777 /]
JRST .+1]
SUB A,(P) ;FORM -# PAGES
MOVN A,A ;..
SUBI A,1 ;..
JUMPGE A,CERR
HRLM A,(P)
; MOVEI A,520 ;READ-EXECUTE PERMIT, DUPLICATE ON WRITE
MOVEI A,200 ;AS CURRENT ACCESS!!!! (MGM 20-MAY-74)
DPB A,[POINT 9,(P),26] ;PUT PROTECTION IN TABLE WORD
CAIN TRM,","
JRST [ CALL SAVNOI ;SPECIAL HANDLING OF NOISE "(FROM)"
JRST SSAV1]
ALLOW TSPC+TALT+TLPR+TLAN
NOISE <on>
TLZ Z,EOLNEF ;EOL JUST TRIGGERED [NEW FILE]
HRROI A,[ASCIZ /SAV/]
CALL COUTFN
JRST CERR
CONFIRM
PUSH P,[0]
HRL A,FORK
HRR A,CJFN1
SETZ C,
SSAVE
CALL RLJFNS
JRST CMDIN4
;.STOPS STOPS1
;STOPS N,N,N...
;SETS TERMINAL TAB STOPS TO INDICATED COLUMNS
.STOPS: SETZB B,C ;CLEAR 3 AC'S IN WHICH TO ACCUMULATE
SETZ D, ;...TAB STOP BITS IN SYSTEM FORMAT.
STOPS1: CALL DECIN ;INPUT DECIMAL NUMBER
JRST CERR
CAILE A,↑D107
JRST CERR
ALLOW TCOM+TEOL+TSPC+TALT
MOVE E,A
IDIVI E,↑D36 ;DIVIDE INTO WORD AND BIT NUMBERS
HRLZI A,B0
MOVN F,F
LSH A,(F) ;POSITION BIT
IORM A,B(E) ;MERGE INTO PROPER WORD
TRNE CBT,TCOM
JRST STOPS1 ;AFTER COMMA GET ANOTHER
CONFIRM
MOVE A,COJFN
STABS ;SET TABS FROM B, C, D.
MOVEM B,PTTYMD+1 ;PROGRAM TELETYPE MODES
MOVEM C,PTTYMD+2
MOVEM D,PTTYMD+3
MOVEM B,ETTYMD+1 ;AND EXEC'S TELETYPE MODES BLOCK
MOVEM C,ETTYMD+2
MOVEM D,ETTYMD+3
RET
;$START .START ..STRT START1 START2
;START
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH
$START: SKIPGE A,FORK ;HANDLE OF INFERIOR FORK, OR -1
ERROR <No program>
GEVEC
HLRZ B,B
CAIE B,<JRST>B53
JRST [ CAIGE B,1
UERR [ASCIZ /No start address/]
RET]
MOVEI A,.JBSA
CALL MAPPF
TLNN A,B5
ERROR <No page 0>
TLNN A,B2
ERROR <Page 0 read-protected>
MOVEI A,.JBSA
HRRZ A,PAGEN(A)
JUMPE A,[UERR [ASCIZ /No start address/]]
RET
;START COMMAND DISPATCHES HERE
.START: CALL $START
CONFIRM
;"RUN" JOINS HERE
;REDIRECT/DETACH...(AND) START JOINS HERE
..STRT: MOVNI B,1 ;START CODE FOR PA1050
CALL CHKPAT
JUMPG B,.+2 ;PA1050 START IF POSITIVE
SETZ B, ;ENTRY VECTOR INDEX 0 FOR START
;"EDIT" ENTRY
START1: MOVEI E,PTTYMD
CALL LTTYMD ;SET PGM TTY MODES
;START FORK WHOSE HANDLE IS IN "FORK" USING ENTRY VECTOR INDEX IN B.
;"REENTER" JOINS HERE.
START2: TLO Z,RUNF ;SAY PROGRAM'S TTY MODES ARE IN EFFECT
SETO A, ;DON'T WANT ANY MAPPED PAGES WHILE RUNNING PROG,
CALL MAPPF ;SO CLEAR BUFFER "PAGEN".
CALL IFORK ;PREPARE FORK(S) AND SETUP LRFORK
CAIL B,1000 ;PROPER ENTRY VECTOR DISPATCH?
JRST [ TLNN B,1 ;DON'T START IF LH NON-0
SFORK ;NO, PA1050 OR OTHER SPECIAL START
JRST WAIT]
SFRKV ;START FORK USING ENTRY VECTOR (USES A,B)
;WAIT WAIT2
;START AND REENTER...
;CONTINUE AND GOTO JOIN HERE.
;ANY OF THE ABOVE WITH REDIRECT OR DETACH ALSO GET HERE.
;WAIT FOR FORK TO TERMINATE, AFTER DETACHING TERMINAL IF "DTACHF" ON.
WAIT: TLNE Z,DTACHF ;"DETACH" COMMAND?
DTACH ;YES, DETACH CONTROLLING TERMINAL.
MOVE A,LRFORK ;INFERIOR BEING RUN
RFORK ;RESUME
WFORK ;WAIT
INTOFF
MOVE A,LRFORK
FFORK ;FREEZE IT IMMEDIATELY
MOVE B,[CALL CUUO] ;SET UUO DISPATCH TO FRUSTRATE
MOVEM B,41 ;MALICIOUS USERS
PUSH P,A
MOVEI A,.JBERR ;TAKE CARE OF ERROR COUNT
CALL MAPPF
TLNN A,B5
JRST WAIT2
TLNN A,B2
JRST WAIT2
MOVE A,PAGEN(A)
ADDM A,.JBERR
WAIT2: SETO 1,
CALL MAPPF
POP P,A
MOVEI E,PTTYMD ;SAVE TTY MODES, AS MODIFIED BY PROGRAM
CALL RTTYMD ;..
TLZ Z,RUNF ;SAY PROG'S TTY MODES NOT IN EFFECT
MOVEI E,ETTYMD ;RESTORE EXEC'S TTY MODES
CALL LTTYMD ;..
;ANALYZE REASON FOR TERMINATION
RFSTS
TLZ A,(1B0) ;FLUSH FROZEN BIT
CAMN A,[2B17] ;VOLUNTARY TERMINATION IS NORMAL
JRST [ INTON
JRST CMDIN2] ;GO INPUT COMMAND
TLNE A,077700 ;DISTINGUISH -1 FROM 0-5, 400000-400005.
JRST [ SETOM FORK ;-1 = UNASSIGNED HANDLE, SAY NO FORK.
SETOM LRFORK ;..DOES THIS HAPPEN IF IT KFORKS ITSELF,
INTON
UERR [ASCIZ /Program killed itself/]];OR IS IT SCREWUP?
PUSH P,A
INTON
POP P,A
;INVOLT WHY IFORK CHKPAT
;START AND REENTER ETC...
;NON-VOLUNTARY TERMINATION
;ALSO USED FOR UNUSUAL TERMINATION OF EPHEMERON
INVOLT: JUMPL A,[CALL SCREWUP]
HLRZ C,A
CAIE C,3 ;FORCED TERMINATION (UNENABLED ERROR PSI)
CALL SCREWUP
MOVEI A,(A) ;MASK PSI CHANNEL THAT CAUSED IT
CAIG A,↑D35 ;CHECK AGAINST TABLE LIMITS
CAIGE A,0 ;..
CALL SCREWUP
;MESSAGE TABLE ADDRESSED BY FOLLOWING LOC ALSO USED BY "RUNSTAT".
WHY: XCT .+1(A) ;ERROR MESSAGE FROM TABLE FOLLOWING
ERROR <Chan %1Q interrupt at %2P>; CHAN 0. THESE HAPPEN IF
ERROR <Chan %1Q interrupt at %2P>; PROGRAM ACTIVATES CHANNEL
ERROR <Chan %1Q interrupt at %2P>; BUT DOES NO EIR OR SIR OR
ERROR <Chan %1Q interrupt at %2P>; HAS 0 TABLE WD FOR CHANNEL.
ERROR <Chan %1Q interrput at %2P>; CHAN 4
ERROR <Chan %1Q interrput at %2P>; CHAN 5
ERROR <Overflow at %2P>; CHAN 6. %2P => TYPE PC FROM RH B OCTAL
ERROR <Floating overflow at %2P>; CHAN 7
ERROR <Chan %1Q interrupt at %2P>; CHAN 8
ERROR <Pushdown overflow at %2P>; CHAN 9
ERROR <End-of-file at %2P>; CHAN 10
ERROR <IO data error at %2P>;
ERROR <Chan %1Q interrupt at %2P>; CHAN 12 "FILE CONDITION 3"
ERROR <Chan %1Q interrupt at %2P>; CHAN 13 "FILE CONDITION 4"
ERROR <Chan %1Q interrupt at %2P>; CHAN 14. TIME OF DAY.
ERROR <Illegal instruction %2X>; %X:INST "AT" PC, SYS MSG IF JSYS
ERROR <Illegal memory read at %2P>
ERROR <Illegal memory write at %2P>
ERROR <Illegal memory execute at %2P>
ERROR <Fork termination interrupt at %2P>; CHAN 19
ERROR <Disk space allocation exceeded at %2P>
REPEAT ↑D15,<ERROR <Chan %1Q interrupt at %2P>
> ;CHAN 21-35
;PREPARE INFERIOR FORK STRUCTURE, CALLED BY GOTO AND START
IFORK: MOVE A,FORK
MOVEM A,LRFORK ;RETURN THIS IN A
RET
;ROUTINE TO SETUP FORK IF PA1050 HAS BEEN INVOKED. START, REENTER,
; GOTO, AND DDT ALL GO TO PA1050 INSTEAD OF THE PROGRAM.
; THE PREVIOUS FORK PC IS ALSO GIVEN TO PA1050, AND IT IN TURN
; FINDS THE PROGRAM'S OLD PC, SETS UP .JBOPC, AND STARTS THE PGM.
; WORD 6 OF THE PA1050 ENTRY VECTOR IS THE START LOCATION FOR THIS.
; LH OF WORD 7 IS WHERE TO STORE FUNCTION CODE: -1 START, -2 REENTER,
; -3 DDT, +N GOTO N
; RH OF WORD 7 IS WHERE TO STORE FORK'S OLD PC
CHKPAT: PUSH P,B ;SAVE CODE WORD
PUSH P,C
MOVE A,FORK
GCVEC ;PA1050 ENTRY VECTOR
HLRZ C,B ;CHECK FOR LENGTH GREATER THAN 8
CAIGE C,1000 ;WHICH ELIMINATES OLD PA1050 VERSIONS
CAIGE C,10 ;AS WELL AS NON-PA1050 PGMS.
JRST [ POP P,C
POP P,B
RET]
MOVEI A,6(B)
CALL LOADF ;GET PA1050 RESTART LOC
EXCH A,-1(P) ;SAVE IT, GET CODE WORD
PUSH P,A
MOVEI A,7(B)
CALL LOADF ;GET PTRS FOR RESTART DATA
PUSH P,A
MOVE A,FORK
RFSTS ;GET FORK'S OLD PC
HLRZ A,A
CAIE A,400002 ;HALT OR FORCE TERM?
CAIN A,400003
JRST [ MOVE A,FORK ;YES, MUST RESTART FORK
SFORK
JRST .+1]
HRRZ A,0(P) ;PTR TO CELL FOR IT
CALL STOREF ;STORE OLD PC IN PA1050 VARIABLE AREA
POP P,A
HLRZ 1,1 ;PTR TO CELL FOR CODE WORD
POP P,B ;CODE WORD
CALL STOREF ;STORE IT
POP P,C
POP P,B ;RETURN PA1050 RESTART LOC IN B
MOVNI A,0(B) ;IF RH OF WD 6 IS .L. 36, IT IS
CAMG A,[-↑D36] ;PSI CHANNEL TO BE GOOSED RATHER THAN
RET ;A RESTART LOCATION
MOVSI B,(1B0) ;COMPUTE PROPER BIT
LSH B,0(A)
MOVE A,FORK
AIC ;BE SURE CHANNEL ON AND PSI ON
EIR
IIC
MOVSI B,1 ;RETURH LH NON-0 TO PREVENT SFORK
RET
;.UNDEL UNDEL1 UNDEL8
;"TYPE" AND "LIST" ARE IN A SEPARATE FILE BELOW.
;UNDELETE <DELETED FILE NAMES>
.UNDEL: NOISE (files)
MOVE A,[2,,2] ;DEFAULT NAME AND EXT TO PRECEDING ONES IN GRP
MOVEI B,B2+B8+B11+B15+B16 ;"MUST BE NEW" AND "IGNORE DELETED BIT"
CALL SPECFN ;INPUT FILE NAME USING GTJFN FLAGS IN B
JRST CERR ;NO DEFAULT FOR NULL INPUT
ALLOW TSPC+TALT+TEOL
CONFIRM
UNDEL1: HRRZ A,@INIFH1 ;JFN
DVCHR
TLNN B,B4 ;MULT DIR DEVICE?
ERROR <You can't undelete non-disk files>
HRRZ A,@INIFH1
MOVE B,[1,,FDBCTL] ;CONTROL BITS WORD OF FILE DESC BLOCK
MOVEI C,C ;READ INTO C
CALL $GTFDB ;DO GTFDB JSYS, NO SKIP IF NO ACCESS
SETO C, ;NO ACCESS, ASSUME DELETED
TLNN C,<FDBDEL>B53 ;"FILE IS DELETED" BIT
JRST [ TLNN Z,GROUPF ;SKIP IF GROUP BEING PROCESSED
UERR [ASCIZ /Not deleted/]; ERROR IF NOT GROUP
JRST UNDEL8] ;IN GROUP JUST SKIP THOSE ALREADY DLTED
CALL TYPIF ;TYPE NAME IF GROUP
HRLI A,FDBCTL ;1: DISPLACEMENT,,JFN
HRLZI B,<FDBDEL>B53 ;MASK OF BITS TO CHANGE
SETZ C, ;VALUE TO CHANGE TO: OFF.
CHFDB ;CHANGE FILE DESCRIPTOR BLOCK
UNDEL8: CALL GNFIL ;GET JFN OF NEXT FILE OF GROUP
JRST RLJFNS ;NO MORE, RELEASE JFN, GO GET NEXT COMMAND.
JRST UNDEL1 ;HAVE ANOTHER
;.UNMOU
;UNMOUNT <DEVICE>
.UNMOU: NOISE (device)
CALL DEVN
TLNN B,B7
ERROR <%1H: not a mountable device>
TLNN B,B5
JRST [ TLNN B,B6
UERR [ASCIZ /%1H: not available/]
UERR [ASCIZ /%1H: assigned to job %3Q/]]
TLNN B,B8
ERROR <%1H: not mounted>
CONFIRM
DSMNT
CALL JERR
RET
;.UNLOA .REWIN
;UNLOAD AND REWIND COMMANDS
.UNLOA: MOVEI F,11 ;MTOPR UNLOAD FUNCTION
CAIA
.REWIN: MOVEI F,1 ;MTOPR REWIND FUNCTION
NOISE (device)
CALL DEVN ;GET A DEVICE NAME
TLNN B,B5 ;AVAILABLE?
JRST [ TLNN B,B6
UERR [ASCIZ /%1H: not available/]
UERR [ASCIZ /%1H: assigned to job %3Q/]]
LDB C,[POINT 9,A,17] ;GET DEVICE TYPE
CAIE C,3 ;IS IT DECTAPE?
CAIN C,2 ;OR MAG TAPE?
CAIA ;YES
ERROR < must be DECtape or magtape>
CONFIRM
TLO A,40000 ;NO DIRECTORY (FOR DECTAPE)
MOUNT
CALL JERR
HRRZ D,A ;GET UNIT NUMBER
LSH D,↑D8
IOR D,[ASCII /DTA0:/] ;FOR DEVICE NAME STRING
CAIE C,3 ;DECTAPE?
TLO D,(<"MTA0:"-"DTA0:">←1) ;NO, MAKE IT MAG TAPE
MOVSI A,1 ;SHORT FORM GTJFN
HRROI B,D ;NAME STRING POINTER
MOVEI E,0 ;MAKE NAME STRING ASCIZ
GTJFN
CALL JERR
MOVE B,[17B9+1B19] ;DUMP MODE, READ
OPENF
CALL JERR
MOVE B,F ;MTOPR FUNCTION
MTOPR
CLOSF
CALL JERR
RET
;.WHERE WHERE1 WHERE2 WHERE4 WHERE5 WHER51 WHER52 WHER58 WHERE6 WHERE7 WHERE8 WHERE9 LITC3
;WHERE (IS USER) <NAME>
.WHERE: NOISE <is user>
CALL DIRNAM ;INPUT DIR (USER) NAME WITH RECOGINITION
TLNE A,B0
JRST CERR ;NOT LOG-IN-UNDER-ABLE
ALTYPE ( )
ALLOW TEOL+TSPC+TALT
CONFIRM ;NEEDED EVEN THOUGH ITS A NON-CONFIRMATION CMD!
SETZ C, ;SETUP FOR NOT HERE
PUSH P,A
MOVE A,['JOBDIR']
CALL $SYSGT ;GET LENGTH OF TABLE AND NUMBER
HLLZ D,B ;NEG LENGTH FOR AOBJN
MOVEI E,0(B) ;TABLE NUMBER
WHERE1: GTB 0(E) ;GET AN ENTRY FROM TABLE
XOR A,(P) ;COMPARE
MOVEI A,(A) ;...MASK RIGHT HALF
JUMPN A,WHERE9
;MATCH FOUND, USE TABLE 0 TO CONVERT JOB # TO TTY #
HRLZ A,D
GETAB
CALL JERR
MOVEI B,0(D) ;JOB NUMBER
JUMPE B,WHERE9 ;DONT SHOW JOB 0
JUMPL A,[ETYPE < Detached, job %2Q>
PUSHJ P,SYST8X
JRST WHERE2]
HLRZ A,A
ETYPE < TTY%1O%, job %2Q>
PUSHJ P,SYST8X ;CONN DIR
PUSHJ P,WHERE4 ;4N HOST
WHERE2: MOVE A,COJFN
MOVEI B,","
BOUT
MOVEI B," "
BOUT
JRST WHERE7
;
; ALSO CALLED FROM SYSTAT
;
;PRINT FOREIGN HOST NAME IF A NETWORK TTY
WHERE4: PUSH P,A ;SAVE TTY# TO COMPARE AGAINST
MOVE A,['LHOSTN']
CALL $SYSGT
JUMPE B,WHERE6 ;TABLE DOES NOT EXIST??
HRLI A,1 ;TABLE INDEX
HRR A,B ;TABLE NUMBER
GETAB
JRST WHERE6
HLRE B,A ;MINUS THE NUMBER OF NET TTY'S
MOVMS B
HRRZS A ;LOWEST NUMBERED NET TTY
ADD B,A ;1 + HIGHEST NUMBERED NET TTY
CAMG A,0(P) ;REJECT IF TTY# .LE. LOWEST NET TTY
CAMG B,0(P) ;REJECT IF HIGHEST+1 .LE. TTY#
JRST WHERE6
MOVE A,['NETBUF']
CALL $SYSGT
JUMPE B,WHERE6 ;NO SUCH TABLE??
HLLZ F,B ;MAKE AOBJN PTR
HRRZ G,B ;SAVE TABLE NUMBER
WHERE5: HRR A,G ;TABLE NUMBER
HRL A,F ;INDEX UNDER CONSIDERATION
GETAB
CALL JERR
XOR A,0(P) ;COMPARE
HRRZS A ;JUST RIGHT HALF
JUMPN A,WHER58 ;TTY# DOES NOT MATCH, TRY NEXT ENTRY
WHER51: MOVE A,['NETSTS']
CALL $SYSGT
JUMPE B,WHERE6 ;TABLE DOESN'T EXIST??
HRR A,B ;TABLE NUMBER
HRL A,F ;INDEX
GETAB
CALL JERR
TLC A,340000 ;LOOK FOR 7 IN LEFT 4 BITS
TLNE A,740000
JRST WHER58 ;NOT IN THE RIGHT STATE
WHER52: MOVE A,['NETAWD'] ;FOUND MATCH
CALL $SYSGT ;NOW GET THE FOREIGN HOST NUMBER
JUMPE B,WHERE6 ;TABLE DOES NOT EXIST??
HRR A,B ;TABLE NUMBER
HRL A,F ;INDEX
GETAB
CALL JERR
LDB B,[POINT 9,A,17] ;FOREIGN HOST NUMBER
MOVE A,COJFN ;OUTPUT JFN
PRINT "["
MOVEI C,↑D10 ;IN CASE NOUT IS NEEDED
CVHST ;HOST TO STRING CONVERSION
NOUT ;DON'T KNOW THAT HOST, PRINT AS NUMBER
JFCL ;STRING PRINTED OR SCREWY NOUT(??)
PRINT "]"
JRST WHERE6
WHER58: AOBJN F,WHERE5 ;TRY NEXT NETBUF TAB ENTRY
WHERE6: SUB P,[1,,1] ;FLUSH SAVED TTY#
POPJ P,
;PRINT SUBSYSTEM NAME
WHERE7: MOVE A,['JOBNAM']
CALL $SYSGT
JUMPE B,WHERE8
HRR A,B
HRL A,D
GETAB
CALL JERR
MOVE C,A
MOVE A,['SNAMES']
CALL $SYSGT
JUMPE B,WHERE8
HRR A,B
HRL A,C
GETAB
CALL JERR
JUMPE A,[ PRINT "?"
JRST WHERE8]
CALL SIXPRT ;PRINT IT
WHERE8: PRINT EOL
SETO C, ;SAY AT LEAT ONE FOUND
;AFTER TYPING CONTINUE LOOP IN CASE HE HAS SEVERAL JOBS.
WHERE9: AOBJN D,WHERE1
SKIPN C
UTYPE [ ASCIZ / Not logged in
/]
JRST CMDIN4
XLIST
LITC3: LIT ;LITERALS HERE TO REDUCE WORKING PAGE SET --
LIST
SUBTTL PDP-10 TENEX EXECUTIVE ** X2CMD.MAC **
;ROUTINES TO DECODE AND EXECUTE SPECIFIC COMMANDS.
;THIS FILE CONTAINS SEVERAL OF THE LONGER AND NOT PARTICULARLY COMMON
;COMMANDS. THEY ARE SEGREGATED FROM THE OTHER, SHORTER, COMMAND
;ROUTINES TO REDUCE THE EXEC'S NORMAL WORKING PAGE SET.
;CONTENTS
; COPY/APPEND
; LIST/TYPE
; REDIRECT/DETACH
;COPY COMMAND: COPY <FILE GROUP> (TO) <FILE>
;AND
;APPEND COMMAND: APPEND <FILE GROUP> TO <FILE>
;TAKE SUBCOMMANDS.
;MODE SUBCOMMAND -- LEGAL FOR-- MODE-BYTESIZE USED--
;ASCII ANY DEVICES 1-7 WHERE LEGAL, ELSE 0-7
;IMAGE ONE DEVICE MUST ACCEPT 10-8 WHERE LEGAL, ELSE 0-8
; MODE 10, OTHER MUST
; NOT BE LPT:.
;IMAGE BINARY NEITHER DEVICE CAN 13-36 WHERE LEGAL, ELSE 0-36
; BE TTY: OR LPT:
;BINARY NEITHER DEVICE CAN 14-36 WHERE LEGAL, ELSE 0-36
; BE TTY: OR LPT:.
;ASCII PARITY PAPER TAPE SOURCE SEE ASCII NOT IMPLEMENTED
;DUMP NON-DIRECTORY DTA OR MTA NOT IMPLEMENTED
;FLAGS IN LH Z
;F1 ON FOR PAGES COPY, OTHERWISE OFF
;F2 ON FOR APPEND, OFF FOR COPY
;F3 ON IF OUTFILE WAS ALREADY OPEN (GROUP SOURCE CASE)
;FLAGS IN RH Z
;BITS FOR MODES SPECIFIED BY SUBCOMMANDS
; B35-N ON FOR MODE N, AS IN DVCHR WORD. THAT IS:
;1 NORMAL - SET IF BYTE SIZE SPECIFIED
;2 ASCII
;400 IMAGE
;4000 IMAGE BINARY
;10000 BINARY
;100000 DUMP
;AC USE
;AA -1 OR BYTE SIZE AND MODE OF PREVIOUS COPY IN GROUP TO SAME DEST
;BB - # BYTES PER PAGE WHEN COPYING BY BYTES
;CC BYTE # OF EOF OF DISK SOURCE, # BYTES COPIED TO DSK DEST
;C, D, E, F SEE 2 PAGES HENCE
;A, B, AND G ALSO USED LOCALLY
;.TTYPE .PRINT TTPRNT .APPEN .COPY COP1A COPFL
.TTYPE: NOISE <file list>
MOVE A,['E COPY']
SETNM
CALL .INFG
HRROI 2,[ASCIZ /TTY:/]
JRST TTPRNT
.PRINT: NOISE <file list>
MOVE A,['E COPY']
SETNM
CALL .INFG
HRROI 2,[ASCIZ /LPT:/]
TTPRNT: MOVSI A,400001
GTJFN
JRST CERR
MOVE B,JBUFP
PUSH B,A
MOVEM B,JBUFP
MOVEM A,OUTDSG
JRST COP1A
;COPY/APPEND
.APPEN: TLO Z,F2 ;SAY APPEND NOT COPY
.COPY: NOISE <file list> ;F2 IS OFF
MOVE A,['E COPY']
SETNM
;DECODE: GET FILE NAMES THEN SUBCOMMANDS
CALL .INFG ;GET INPUT FILE GROUP DESCRIPTOR
;ALLOWS *'S, AND COMMAS IF THEY ARE
;IMMEDIATE FILE NAME TERMINATOR.
ALLOW TSPC+TALT+TLPR
NOISE <to>
MOVE A,[2,,2] ;SAY DEFAULT NAME AND EXT TO THOSE OF INPUT FILE
MOVEI B,(1B0+1B3) ;NORMAL OUTPUT FILE FLAGS FOR "COPY"
TLNE Z,F2 ;SKIP IF "COPY" NOT "APPEND"
MOVEI B,(1B3) ;PRINT NEW FILE, ETC.
CALL SPECFN ;COLLECT FILE NAME, GTJFN FLAGS IN RH B.
JRST CERR ; NO DEFAULT FOR "-" INPUT
MOVEM A,OUTDSG ;DESTINATION JFN
;TRZ Z,-1 ;CLEAR ALL SUBCOMMAND BITS (NEEDED ←←←←←?)
TLNN Z,F2
JRST COP1A
;MAKE SURE DESTINATION DEVICE IS OK FOR "APPEND"
HRRZ A,OUTDSG
DVCHR
LDB D,[POINT 9,B,17]
;NO OTHER DEVICES WORK 12/3/70
JUMPN D,[UERR[ASCIZ/Destination file must be on disk/]]
COP1A: CALL SPRTR ;ANALYZE TERMINATOR, READING MORE IF NEC. 3 RETS
JRST CERR
JRST [ CONFIRM ;COMMA. GET SUBCOMMANDS
SUBCOM $COPY ;SUBCOMMANDS FROM TABLE $COPY
JRST .+2]
CONFIRM
SETO AA, ;SAY NO PREVIOUS COPY IN GROUP
;TOP OF LOOP OVER INPUT FILE NAMES
COPFL: CALL TYPIF ;TYPE INPUT FILE NAME IF PROCESSING GROUP
;WHEN OUTPUT FILE GROUP DESCRIPTORS IMPLEMENTED, DETERMINE HERE
;THE DESTINATION, AND SETO AA, UNLESS THE SAME AS BEFORE.
;CHOOSE MODE AND BYTE SIZE FOR COPY/APPEND AS A FUNCTION OF
;DEVICES AND SUBCOMMANDS GIVEN.
;AC USE
; C: SOURCE DEVICE TYPE NUMBER
; D: DESTINATION DEVICE TYPE NUMBER
; RH E: BYTE(6) READ MODE,WRITE MODE,BYTE SIZE
; F: DISC SOURCE BYTE SIZE
;SET UP E PER SUBCOMMAND, IGNORING FOR THE MOMENT WHETHER MODE
; IS LEGAL FOR DEVICES.
TRNN Z,1 ;BYTE SIZE GIVEN MEANS MODE 0
SETZ E, ;FOR NO SUBCOMMAND, BYTE SIZE IS DEFAULTED LATER
TRNE Z,2
MOVEI E,010107
TRNE Z,400
MOVEI E,101010
TRNE Z,4000
MOVEI E,131344
TRNE Z,10000
MOVEI E,141444
;COP2A
;COPY/APPEND...
;DETERMINING MODE-BYTESIZE...
;FOR EACH FILE, DO A "DVCHR" TO GET TYPE NUMBER AND TO SEE IF MODE
; IS LEGAL FOR DEVICE. CHANGE MODE TO 0 IF NOT LEGAL.
;DESTINATION
HRRZ A,OUTDSG
DVCHR
TLNN B,B0
ERROR <%1H: can't do output>
LDB D,[POINT 9,B,17]
TRZ B,600000
TRNN Z,(B) ;SKIP IF MODE SUBCOM GIVEN & OK FOR THIS DEVICE
JRST [ TRZ E,007700 ;WRITE IN MODE 0
TRNN B,1 ;CAN DEVICE USE MODE 0 ?
UERR [ASCIZ /%1H: can't do normal mode output/]
JRST .+1]
;SOURCE
HRRZ A,@INIFH1
DVCHR
TLNN B,B1
ERROR <%1H: can't do input>
LDB C,[POINT 9,B,17]
TRZ B,600000
TRNN Z,(B) ;SUBCOMMAND GIVEN & OK ?
JRST [ TRZ E,770000 ;READ IN MODE 0
TRNN B,1 ;CAN DEVICE USE MODE 0?
UERR [ASCIZ /%1H: can't do normal mode input/]
JRST .+1]
;ALSO FOR DISK SOURCE GET BYTE SIZE IN F
JUMPN C,COP2A
HRRZ A,@INIFH1
MOVE B,[1,,FDBBYV] ;BYTE SIZE IN B6-11
PUSH P,C
MOVEI C,F
CALL $GTFDB ;DO GTFDB, NO SKIP ON NO ACCESS
ERROR <Access to source not allowed>
;SHOULD BE FIXED AT MONITOR LEVEL ←←←←← PUSH RST ←←←←←
POP P,C
LDB F,[POINT 6,F,11]
COP2A:
;COP3
;COPY/APPEND...
;DETERMINING MODE-BYTESIZE...
;IF MODE SUBCOMMAND IS ACCEPTABLE TO ONE DEVICE,
;IT IS ACCEPTED AND MODE 0 USED FOR OTHER DEVICE, PROVIDED OTHER
; DEVICE WILL ACCEPT THE BYTE SIZE (ONLY TTY AND LPT ARE RESTRICTED).
;IF MODE IS ACCEPTABLE TO NEITHER, ACTION DEPENDS ON SUBCOMMAND;
; IF UNACCEPTABLE A WARNING MESSAGE IS TYPED AND DEFAULT EXECUTION
; PROCEEDS, SO THAT A WHOLE GROUP COPY DOESN'T GET ABORTED.
TRNN Z,177777 ;ANY MODE SUBCOMMANDS GIVEN?
JRST COPDEF ;NO, GO DEFAULT MODE AND BYTE SIZE
TRNN Z,1 ;MODE 0 REQUESTED, OR
TRNE E,777700 ;EITHER MODE NON-0?
JRST COP3 ;YES, SUBCOMMAND ACCEPTABLE TO ONE DEVICE
;SUBCOMMAND-DEPENDENT ACTION FOR SBCMD WHOSE MODE IS LEGAL FOR
;NEITHER SOURCE NOR DESTINATION DEVICE
TRNE Z,2
JRST [ MOVEI E,7 ;ASCII ALWAYS LEGAL, USE 0-7.
JRST COP3]
TRNN Z,4000 ;TREAT "IMAGE BINARY" AS "BINARY"
TRNE Z,10000
JRST [ MOVEI E,44 ;"BINARY", USE 0-36, LEGAL EXCEPT FOR
JRST COP3] ;TTY OR LPT, DETECTED AT COP3.
;ONLY IMAGE GETS THRU TO HERE
JRST COPDF1 ;GO TYPE MESSAGE AND DEFAULT
;IMAGE IS NOT INTERPRETED FOR DEVICES OTHER THAN PAPER
;TAPE BECAUSE ITS BYTE SIZE WILL PRESUMABLY BE
;DIFFERENT WHEN IT IS DEFINED FOR OTHER DEVICES.
;IF HERE, ALL SET EXCEPT SUBCOMMAND MAY HAVE SPECIFIED A BYTE SIZE
;ILLEGAL FOR DEVICE. CHECK FOR THAT.
COP3: LDB B,[POINT 6,E,35] ;CHOSEN BYTE SIZE
CAIE C,12
CAIN D,12
JRST [ CAIE B,7 ;TTY TAKES 7 OR 8 ONLY
CAIN B,10
JRST .+1
JRST COPDF1] ;TYPE MESSAGE AND DEFAULT
CAIN D,7 ;LPT TAKES 7 ONLY
CAIN B,7
JRST COP4 ;ALL IS OK
;JRST COPDF1
;COPDF1 COPDEF
;COPY/APPEND...
;DETERMINING MODE-BYTESIZE... DEFAULT CASE...
;NO ACCEPTABLE SUBCOMMAND GIVEN.
;DEFAULT MODE AND BYTE SIZE AS A FUNCTION OF DEVICES USED.
;MODE ALWAYS 0 AT PRESENT.
COPDF1: TYPE < [Illegal mode subcommand being ignored]
>
COPDEF: JUMPN D,.+3
JUMPN C,.+2
;DISK TO DISK USES SOURCE BYTE SIZE
SKIPA E,F ;DISK SOURCE BYTE SIZE IS IN F
;MOST OTHER CASES USE 0-36
MOVEI E,↑D36
;IF TTY: OR LPT: INVOLVED, USE 0-7
CAIE C,12
CAIN D,12
JRST .+2
CAIN D,7
JRST [ MOVEI E,7
JRST COP4]
;COPDF3 COPDF4 COPDF5 COPDF6 COP4
;COPY/APPEND...
;DETERMINING MODE-BYTESIZE... DEFAULT CASE...
;SPECIAL CASES FOR PAPER TAPE
CAIE C,4 ;PTR
JRST COPDF3
CAIN D,5 ;PTP
JRST [ MOVEI E,↑D8 ;USES 0-8 TO DUPLICATE PAPER TAPE
JRST COP4]
HRRZ B,OUTDSG ;PTR TO OTHER DEVICES DEPENDS ON DEST EXT
JRST COPDF4
COPDF3: CAIE D,5 ;PTP
JRST COPDF6
JUMPE C,[MOVE E,F ;DSK TO PTP
CAIN F,7 ;IF SC BYTE SIZE 7, USE IT, NO MESSAGE.
JRST COP4
CAIE F,10 ;IF 8, USE IT, TYPE MESSAGE
MOVEI E,↑D36 ;OTHERWISE ASSUME 36 AND TYPE MESSAGE
JRST COPDF5] ;NOTE THAT CAN'T TRUST SIZE OF 36 IN
;FILE BECAUSE OTHER SIZES CAN BECOME
;36 IF FILE IS COPIED TO DTA AND BACK.
HRRZ B,@INIFH1 ;OTHER DEVICES TO PTP, DEPENDS ON SC EXT
COPDF4: ;ONE IS PAPER TAPE, OTHER ISN'T. USE 0-36 FOR FILES
;WITH EXTENSION OF .REL OR .SAV, 0-7 FOR OTHERS.
;TYPE MESSAGE. JFN OF NON-PAPERTAPE DEVICE NOW IN B.
MOVE A,CSBUFP
HRROI A,1(A) ;BEGINNING OF NEXT WORD OF STRING BUFFER
SETZM (A)
PUSH P,C
HRLZI C,B11
JFNS
POP P,C
MOVE A,CSBUFP
MOVE A,1(A) ;FIRST WORD OF EXTENSION STRING
CAME A,[ASCIZ /REL/]
CAMN A,[ASCIZ /SAV/]
JRST .+2 ;REL OR SAV, USE 36 (ALREADY IN E)
MOVEI E,7 ;OTHER EXT OR NON-DIR DEVICE, USE 0-7
;A MARGINAL ASSUMPTION HAS BEEN MADE ABOUT PAPER TAPE,
;TYPE EXPLANATORY MESSAGE.
COPDF5: TYPE < [>
CAIN E,7
TYPE <ASCII>
CAIN E,10
TYPE <Image>
CAIN E,44
TYPE <Binary>
TYPE < mode assumed]
>
;JRST COP4
COPDF6: ;ADD CASES TO THE DEFAULTING STUFF HEHE
COP4: ;NOW HAVE MODES AND BYTE SIZE IN E
;COP5A COP5B
;COPY/APPEND...
;HAVE FINISHED CHOOSING MODE-BYTESIZE.
;OPEN FILES NOW, SO FFUFP WILL WORK.
;SOURCE
MOVEI B,1B19 ;READ BIT FOR OPENF
LDB A,[POINT 6,E,23] ;GET READ MODE FROM E
DPB A,[POINT 4,B,9]
LDB A,[POINT 6,E,35] ;BYTE SIZE
DPB A,[POINT 6,B,5]
HRRZ A,@INIFH1 ;JFN
CALL $OPENF ;OPENF WITH CHECK FOR PRI IO FILES
;AND FANCY ERROR MESSAGES
;DESTINATION
HRRZ A,OUTDSG
GTSTS
JUMPGE B,COP5A
;DEST ALREADY OPEN, ITS ANOTHER COPY IN GROUP, SEE IF
;MODE-BYTESIZE CONSISTENT, CHANGE WHERE POSSIBLE
TLO Z,F3 ;SAY IT WAS ALREADY OPEN
MOVE B,E ;MODES-BYTESIZE CHOSEN FOR THIS COPY
XOR B,AA ;COMPARE TO THOSE USED FOR LAST COPY
TRNN B,7777 ;OUTPUT MODE & SIZE THE SAME?
JRST COP5B ;YES, ALL IS OK
JUMPN D,.+2 ;IF DEST NOT DSK, CHANGE ILLEGAL
TRNE B,7700 ;FOR DSK SIZE CAN CHANGE BUT MODE CAN'T
ERROR <Illegal mode or byte size change,
multiple-source copy cannot proceed>
LDB B,[POINT 6,E,35]
SFBSZ
JRST COP5B
JRST COP5B ;RET +2 OBSERVED 12/18/70 ←←←←←←
COP5A: ;DEST WASN'T OPEN (NORMAL CASE), OPEN IT
TLZ Z,F3 ;SAY JUST OPENED (HENCE PAGE COPY OK)
MOVEI B,1B20 ;"WRITE" BIT FOR OPENF
TLNE Z,F2 ;SKIP IF "COPY" NOT "APPEND"
MOVEI B,1B22 ;"APPEND" BIT FOR OPENF
LDB A,[POINT 6,E,29] ;GET WRITE MODE FROM E
DPB A,[POINT 4,B,9]
LDB A,[POINT 6,E,35] ;BYTE SIZE
DPB A,[POINT 6,B,5]
HRRZ A,OUTDSG ;JFN
CALL $OPENF
COP5B: MOVE AA,E ;SAVE MODE AND BYTE SIZE (NEEDED IF ANOTHER
;COPY TO SAME FILE OCCURS IN GROUP)
;HAVE ESTABLISHED MODE-BYTESIZE AND OPENED FILES.
;NOW DECIDE WHETHER A COPY WITH DISK SOURCE IS TO BE DONE BY BYTES
;OR PAGES (SET F1 FOR PAGES), BECAUSE BYTES CASE REQUIRES SPECIAL
;CHECKS BELOW.
TLZ Z,F1 ;SAY BYTES FOR NOW
JUMPN C,COP6Z ;NON-DISC SOURCE, NO SPECIAL CHECK
TLNN Z,F2+F3 ;"APPEND" COMMAND AND OUTFILE ALREADY OPEN
;(GROUP CASE) CAUSE BYTE COPYING
JUMPE D,[ ;NON-DISK DEST ALWAYS REQUIRES BYTE COPY.
;BUT IF HERE, DEST IS ALSO DISK, CAN COPY BY
;PAGES.
TRNN Z,177777 ;DON'T CPY BY PAGES IF MODES SPECIFIED
TLO Z,F1 ;SAY COPY BY PAGES
JRST COP6Z] ;SKIP SPECIAL CHECK
;COP6C COP6Z
;COPY/APPEND...
;SPECIAL WARNING CHECKS FOR COPYING/APPENDING FROM DSK BY BYTES.
;(OTHER CASES BRANCHED AROUND THIS CODE ABOVE.)
;CHECK FOR HOLES NOT BEYOND EOF AND ANY PAGES BEYOND EOF IN SOURCE FILE
; AND TYPE WARNING MESSAGES IF FOUND.
PUSH P,C
PUSH P,D
;GET PAGE # OF LAST DATA BYTE INTO B
HRRZ A,@INIFH1
SIZEF ;BYTE # OF EOF INTO B
CALL JERR
SUBI B,1 ;CONVERT BYTE # OF EOF TO BYTE # LAST DATA BYTE
JUMPL B,COP6C ;IF IT WAS 0, ITS NOW -1, WHICH IS PAGE #.
MOVEI C,↑D36
IDIV C,F ;36 / BYTESIZE = # BYTES PER WORD
IDIV B,C ;BYTE # / THAT MAKES IT WORD #
IDIVI B,1000 ;MAKE IT PAGE # OF LAST DATA BYTE
COP6C: ;TEST FOR FIRST FREE PAGE NOT BEING AFTER LAST DATA BYTE'S PAGE
HRRZ A,@INIFH1
FFFFP ;FIND FIRST FREE FILE PAGE
CAMN A,[-1]
JRST .+3 ;NO FREE PAGES IN FILE
CAIL B,(A)
TYPE < [Holes in file]
>
;CHECK FOR USED PAGES AFTER LAST DATA BYTE PAGE
HRL A,@INIFH1
HRR A,B ;LAST DATA BYTE'S PAGE
CALL $FNUFP ;INCREMENT A AND FIND NEXT USED PAGE
JUMPE A,.+2 ;0 RETURNED MEANS NO USED PAGE
TYPE < [Pages after EOF will not be copied]
>
POP P,D
POP P,C
COP6Z:
;COP7A
;COPY/APPEND...
;IF WE WISH TO CONFIRM EACH COPY IN GROUP, HERE IS WHERE TO DO IT.
;NOW, AT LAST, WE ARE READY TO COPY. WELL, ALMOST.
;THERE ARE 5 CASES:
; DISK TO DISK,
; DONE BY PAGES, REPRODUCING "HOLES" AND PAGES AFTER BYTE EOF
; TTY TO ANYTHING, TERMINATED BY ↑Z
; DISK TO OTHER DEVICE OR DISK-DISK FOR APPEND OR OUTFILE ALREADY OPEN,
; PAGE READ AND BYTE WRITE.
; OTHER DEVICE TO DISK, USUALLY BYTE READ AND PAGE WRITE.
; ANY OTHER COMBINATION, DONE ENTIRELY BY BYTES.
;COMPUTE NEGATIVE NUMBER OF BYTES PER PAGE INTO BB
;(DONE NOW CAUSE CAN CLOBBER CC)
MOVEI BB,↑D36 ;# BITS PER WORD
LDB CC,[POINT 6,E,35] ;# BITS PER BYTE
IDIV BB,CC ;FORM # BYTES PER WORD
IMUL BB,[-1000] ;FORM - # BYTES PER PAGE
;GET DISK SOURCE BYTE EOF IN CC
HRRZ A,@INIFH1
JUMPN C,COP7A
PUSH P,C
PUSH P,D
SIZEF ;GETS BYTE # OF EOF IN FILE'S BYTESIZE INTO B
CALL JERR
;TRANSLATE FROM BYTE SIZE OF FILE TO BYTE SIZE OF COPY.
;NEW PTR = (OLD PTR*(36/NEW BYTE SIZE))/(36/OLD BYTE SIZE)
; WITH ALL DIVISIONS INTEGER AND OUTERMOST ONE ROUNDED UP
MOVEI C,↑D36
IDIV C,F ;F: SOURCE FILE (OLD) BYTE SIZE
MOVE CC,C
MOVEI C,↑D36
LDB D,[POINT 6,E,35] ;COPY (NEW) BYTE SIZE
IDIV C,D
MUL B,C
DIV B,CC
JUMPE C,.+2 ;REMAINDER 0 ?
ADDI B,1 ;NO, ROUND UP.
MOVE CC,B ;BYTE # OF EOF IN COPY BYTE SIZE
POP P,D
POP P,C
COP7A:
TLNE Z,F1 ;COPY BY PAGES FLAG ON?
JRST PAGES ;YES, GO COPY BY PAGES
;COPTTY COPTT1 CTTEOF
;COPY/APPEND... DISPATCHING TO VARIOUS EXECUTION CASES...
;COPY BY BYTES OR A COMBINATION OF BYTES AND PAGES.
;HRRZ A,@INIFH1 ;ONE JFN IN A
HRRZ F,OUTDSG ;OTHER ALWAYS IN F
;GENERATE POINTER TO BUFFER W PROPER BYTE SIZE IN G
MOVE G,[440000,,BUF1] ;P FIELD AND ADDRESS
DPB E,[POINT 6,G,11] ;BYTE SIZE = S FIELD
;NOW DISPATCH TO THE VARIOUS CASES
CAIN C,12 ;SOURCE TTY: ?
JRST COPTTY ;YES, SPECIAL CODE TO END ON ↑Z.
JUMPE C,CPGBYT ;JUMP IF SOURCE DISK
JUMPE D,[ ;JUMP IF DEST DISK
TLNE Z,F2+F3 ;PG OUTPUT OK IF NOT "APPEND" AND
JRST .+1 ;OUTFILE WASN'T ALREADY OPEN (GROUP)
JRST CBYTPG] ;USE PAGES TO WRITE ON DISK
JRST COPBY ;ALL OTHER CASES
;COPY BY BYTES WITH TELETYPE SOURCE
;DO BYTE BY BYTE, WATCHING FOR ↑Z TERMINATOR
COPTTY: MOVEI B,CTTEOF ;WHERE TO GO ON EOF PSI
MOVEM B,EOFDSP ;(DON'T THINK IT CAN OCCUR 11/20/70)
COPTT1: BIN
CAIN B,CTRLZ
CTTEOF: JRST [ PRINT EOL ;IN CASE SOURCE IS CONTROLLING TTY
JRST CBYEF1] ;GO DELETE EXTRA PAGES IF DEST IS DSK
EXCH A,F
BOUT
EXCH A,F
JRST COPTT1
;COPBY COPB1 CBYEOF CBYEF1 CBYEF2
;COPY/APPEND...
;COPY/APPEND BY BYTES, NON-TTY-SOURCE CASE
;USE FULL PAGE SINS AND SOUTS FOR SPEED.
COPBY: MOVEI B,CBYEOF
MOVEM B,EOFDSP ;WHERE TO GO ON EOF PSI
COPB1: MOVE B,G ;BYTE PTR
MOVE C,BB ;BYTE COUNT, NEG FOR NO SPECIAL TERM CHARACTER
SIN ;INPUT A STRING (JFN ALL SET IN A)
;SIN CAUSES EOF PSI AFTER READING WHATEVER CHARACTERS
;THERE ARE IF NOT A WHOLE "COUNT"'S WORTH LEFT IN FILE
EXCH A,F ;GET DESTINATION JFN, SAVE SOURCE JFN
MOVE B,G ;BYTE PTR AGAIN
MOVE C,BB ;SAME COUNT
SOUT ;OUTPUT STRING
EXCH A,F ;BACK TO SOURCE JFN
JRST COPB1 ;LOOP TILL EOF PSI
;EOF PSI WHILE COPYING BY BYTES (NON-TTY CASE)
;OUTPUT PARTIAL STRING INPUT BEFORE EOF OCCURRED
; (NOTE THAT C IS UPDATED TO REFLECT THOSE BYTES WHICH WERE READ)
CBYEOF: EXCH A,F ;GET DEST JFN
MOVE B,G ;THAT GOOD OLD BYTE PTR
SUBM BB,C ;CREATE COUNT IN C OF CHARS THAT WERE INPUT
JUMPE C,.+2 ;0 COUNT, NO SOUT!
SOUT ;OUTPUT THE LAST PART
;IF DESTINATION WAS DISK, DELETE ANY ADDITIONAL PAGES
; (CLOSF DOES NOT DO THIS, BUT WILL LATER ZERO REST OF LAST PAGE).
;TTY CASE JOINS HERE.
CBYEF1: HRRZ A,OUTDSG
DVCHR
LDB A,[POINT 9,B,17] ;DEVICE TYPE 0 IS DSK
JUMPN A,COPEOF ;IF NOT DISK, DONE HERE
LDB D,[POINT 6,E,35] ;GET BYTE SIZE USED IN COPYING
HRRZ A,OUTDSG
RFPTR ;GETS BYTE # OF LAST DATA BYTE IN B
CALL JERR
MOVEI C,↑D36
IDIV C,D ;36/BYTESIZE = # BYTES PER WORD
IDIV B,C ;BYTE # /THAT = WORD # OF LAST DATA BYTE
IDIVI B,1000 ;MAKE IT PAGE #
HRR A,B
HRL A,OUTDSG
CBYEF2: CALL $FNUFP ;FIND A PAGE
JUMPE A,COPEOF ;NO MORE PAGES IN FILE, DONE
MOVE B,A
SETO A,
HRLZI C,1
PMAP ;DELETE THE PAGE
MOVE A,B
JRST CBYEF2
;CPGBYT CPGBY2 CPGBY3 CPGBY4 CPBEOF
;COPY/APPEND...
;COPY FROM DISK, READING BY PAGES AND WRITING BY BYTES.
;TRANSFERS ZEROS FOR HOLES OR BEYOND BYTE EOF.
;ADDED TO SPEED UP DISK TO LPT COPY.
;AT ENTRY: A,F: JFNS
; G: BYTE PTR TO BUFFER PAGE
; BB: - # BYTES / PAGE
; CC: BYTE # OF EOF
;ALSO: A: SOURCE JFN,,PAGE #
CPGBYT: HRLZ A,@INIFH1
CPGBY2: RPACS
TLNN 2,(1B5) ;PAGE EXISTS?
JRST .+4 ;NO, DON'T MAP IT
MOVE B,[B0,,<BUF1>B44]
HRLZI C,B2+1
PMAP ;MAP IN THE PAGE
;HAVE A PAGE IN SOURCE FILE, DECIDE WHAT TO DO WITH IT BY
;COMPARING PAGE # AND FILE'S BYTE EOF
HRRZ C,A ;PAGE #
IMUL C,BB ; - BYTE # OF FIRST BYTE IN PAGE
ADD C,CC ;CC: BYTE # OF EOF
MOVN C,C ;FORM - # BYTES IN OR BEYOND THIS PAGE
JUMPGE C,CPBEOF ;NONE, DONE.
;TRANSFER PARTIAL PAGE IF THIS IS EOF PAGE, ELSE WHOLE PAGE.
CAMGE C,BB ;- # BYTES/PAGE
MOVE C,BB ;MAXIMUM TRANSFER
RPACS
TLNN 2,(1B5) ;PAGE EXISTS?
JRST CPGBY4 ;NO, USE ZEROS
;OUTPUT # BYTES IN C
EXCH A,F ;GET DEST JFN
MOVE B,G ;STRING PTR TO BUFFER
SOUT ;STRING OUTPUT
CPGBY3: EXCH A,F
AOJA A,CPGBY2 ;DO NEXT PAGE
CPGBY4: EXCH A,F
SETZ 2,
BOUT ;DO PAGE WORTH OF ZEROS
AOJL C,.-1
JRST CPGBY3
;COPY BY PAGES-BYTES EOF. CLEAR BUFFER.
CPBEOF: SETO A,
MOVE B,[B0,,<BUF1>B44]
HRLZI C,1
PMAP
JRST COPEOF
;CBYTPG CBYPG2 CBPGEF CBPEF3
;COPY/APPEND...
;COPY NON-DISK TO DISK IN NON-APPEND, NON MULTIPLE SOURCE CASE.
;USES BYTES FOR INPUT, PAGES FOR OUTPUT.
;ADDL ACS: F: DEST JFN,,PAGE #
; CC: # BYTES TRANSFERRED+1, USED TO SET DEST EOF PTR.
CBYTPG: HRLZ F,OUTDSG
MOVEI B,CBPGEF
MOVEM B,EOFDSP ;WHERE TO GO ON EOF
SETZ CC,
CBYPG2: SETO A, ;CLEAR BUFFER AT TOP OF LOOP TO MAKE SURE
MOVE B,[B0,,<BUF1>B44] ;...OF EOF PAGE IS 0
HRLZI C,1
PMAP
HRRZ A,@INIFH1
MOVE B,G
MOVE C,BB ;NEG # BYTES/PAGE
SUB CC,C ;COUNT BYTES TRANSFERRED
SIN ;READ A PAGE'S WORTH OF BYTES
MOVE B,F
MOVE A,[B0,,<BUF1>B44]
HRLZI C,B3+1
PMAP ;MAP OUT THE PAGE
AOJA F,CBYPG2 ;NEXT PAGE AND LOOP
;BYTES-PAGES END OF FILE
CBPGEF: ADD CC,C ;ADJUST FOR UNUSED PART OF BYTE COUNT
CAMN C,BB ;WHOLE PAGE UNUSED?
SKIPA A,[-1] ;YES, PUT NO PAGE IN DESTINATION
MOVE A,[B0,,<BUF1>B44]
CBPEF3: MOVE B,F
HRLZI C,B3+1
PMAP ;MAP OUT LAST PAGE OR DELETE PAGE
;FAKE THINGS UP AND ENTER PAGES-PAGES ROUTINE TO DELETE RESET OF DEST
;AND SET EOF AND BYTE SIZE
SETZ D, ;SAYS NO MORE SOURCE "PAGES"
JRST PAGE5A
;PAGES PAGES3 PAGES4
;COPY/APPEND...
;COPY DISK TO DISK BY PAGES
;NOTE THAT BYTE SIZE IN E MUST BE PRESERVED
PAGES: HRLZ D,@INIFH1 ;D: SOURCE JFN,,PAGE #
HRLZ F,OUTDSG ;F: DEST JFN,,PAGE #
;D AND F ARE SET TO 0 AFTER ALL PAGES IN FILE ARE USED
;GET FIRST PAGE IN EACH FILE
MOVE A,D
CALL $FFUFP
MOVE D,A
MOVE A,F
CALL $FFUFP
MOVE F,A
;HAVE A PAGE IN EACH FILE. DECIDE WHAT TO DO WITH THEM.
PAGES3: JUMPE F,[;NO MORE PAGES IN DEST
JUMPE D,PAGES9 ;ALSO NO MORE IN SOURCE, DONE.
JRST PAGES5] ;GO COPY PAGE
JUMPE D,PAGES4 ;NO MORE PAGES IN SOURCE, DELETE REST OF DEST
MOVEI A,(D)
CAIG A,(F) ;COMPARE SOURCE PAGE # TO DEST PAGE #
JRST PAGES5
;DELETE DEST PAGES CORRESPONDING TO "HOLE" IN SOURCE
PAGES4: SETO A,
MOVE B,F
HRLZI C,1 ;PMAP DISPOSAL INFO
PMAP
MOVE A,F
CALL $FNUFP ;NEXT PAGE IN DEST
MOVE F,A
JRST PAGES3 ;GO DECIDE AGAIN
;PAGES5 PAGE5A PAGES6
;COPY/APPEND...
;COPY BY PAGES...
;COPY A PAGE
PAGES5: MOVE A,D ;SOURCE JFN AND PAGE NUMBER
MOVE B,[B0,,<BUF1>B44]
HRLZI C,B2+1
PMAP ;MAP SOURCE PAGE INTO BUFFER
HRL A,OUTDSG ;DON'T USE F HERE, MAY BE 0!
HRRI B,<BUF2>B44
HRLZI C,B3+1
PMAP ;MAP DESTINATION PAGE INTO ANOTHER BUFFER
MOVE A,[BUF1,,BUF2]
BLT A,BUF2+777 ;COPY DATA
MOVEI A,(D) ;MASK PAGE # OF PAGE JUST COPIED
CAIGE A,(F) ;COMPARE TO DEST PAGE #
JRST PAGES6 ;PAGE WAS COPIED INTO A HOLE IN DEST
;COPY BY BYTES-PAGES COMES HERE AFTER EOF WITH D 0 AND BB,CC,F CORRECT
; TO DELETE REST OF DEST FILE AND SET ITS PTR AND BYTE SIZE.
PAGE5A: MOVE A,F
CALL $FNUFP ;NEXT PAGE IN DEST
MOVE F,A
PAGES6: MOVE A,D
CALL $FNUFP ;ALWAYS NEXT PAGE IN SOURCE
MOVE D,A
JRST PAGES3
;PAGES9 COPEOF
;COPY/APPEND...
;FINISH UP COPY BY PAGES.
;ALSO USED FOR BYTES-PAGES, SO NOTHING DISK-DEPENDENT CAN BE DONE HERE.
PAGES9: SETO A, ;CLEAR BUFFERS
MOVE B,[B0,,<BUF1>B44]
HRLZI C,1
PMAP
HRRI B,<BUF2>B44
PMAP
;SET END POINTER OF DESTINATION FILE
MOVE B,CC ;BYTE COUNT OF SOURCE EOF
HRRZ A,OUTDSG ;SET POINTER FOR THIS OPENING OF FILE, IN CASE
SFPTR ;SEQUENTIAL I/O FOLLOWS (GROUP SOURCE CASE)
CALL JERR
HRLI A,FDBSIZ ;SET EOF PTR IN FILE (CLOSF DOES NOT WHEN
MOVE C,B ;NO SEQUENTIAL OUTPUT HAS BEEN DONE)
SETO B,
CHFDB ;CHANGE FILE DESCRIPTOR BLOCK
;SET BYTE SIZE OF DESTINATION FILE
;(CLOSF DOES NOT SET IT WHEN NO SEQUENTIAL OUTPUT HAS BEEN DONE)
;MOVE A,OUTDSG
HRLI A,FDBBYV
SETZ C,
DPB E,[POINT 6,C,11] ;BYTE SIZE STILL IN E
MOVSI B,(77B11) ;BITS TO CHANGE
CHFDB
;COPY OR APPEND COMPLETE.
;PAGE-COPY FALLS IN, ALL OTHER CASES BRANCH HERE.
COPEOF: SETZM EOFDSP ;(REDUNDANT EXCEPT IN ↑Z ON TTY CASE)
CALL GNFIL ;GET NEXT FILE IN INPUT GROUP
JRST [ CALL RLJFNS ;NO MORE FILES, RELEASE JFNS
JRST CMDIN4] ;GO BACK TO COMMAND INPUT LOOP
JRST COPFL
;$FNUFP $FFUFP
;COPY/APPEND...
;SUBROUTINE TO GET NEXT USED PAGE # OF DISK FILE.
;TAKES IN A: JFN,,CURRENT PAGE #. RETURNS A 0 IF NO MORE PAGES.
;MUST BE NEAR COPY TO MINIMIZE PAGE FAULTS
$FNUFP: JUMPE A,[RET] ;ALREADY AT END, NOP.
ADDI A,1 ;NEXT PAGE NUMBER
TRNN A,-1
JRST [ SETZ A, ;WRAP-AROUND FROM MAX PAGE NUMBER
RET]
;ENTRY TO GET FIRST USED PAGE NUMBER. DOESN'T INCREMENT FIRST.
$FFUFP: FFUFP
CALL [ CAIE A,FFUFX3 ;"NO MORE PAGES" ERROR?
JRST JERR
SETZ A,
RET]
RET
;$COPY .ASCII ASCII1 $ASCII .BINAR .BYTE .IMAGE $IMAGE .RECOR
;COPY/APPEND SUBCOMMAND TABLE AND ROUTINES
$COPY: TABLE
TE ASCII
TE BCD,ONEWD+INVIS,NIYE
TE BINARY,ONEWD
T BYTE,LPROK+INVIS
TE DUMP,ONEWD+INVIS,NIYE
TE IMAGE
T RECORD,LPROK+INVIS
TEND
.ASCII: KEYWD $ASCII
TE ,,2
JRST CERR
ASCII1: CONFIRM
TRNE KWV,B0
TYPE < [ASCII parity not implemented yet, will treat as ASCII]
>
HRR Z,KWV ;NEW FLAGS FROM TABLE ENTRY
RET
$ASCII: TABLE
TE PARITY,,B0+2 ;B0: PARITY CHECK. 2: ASCII MODE
TEND
.BINAR: HRRI Z,10000 ;"BINARY" MODE BIT (MODE 14)
RET
.BYTE: NOISE (size)
CALL DECIN
JRST CERR
CONFIRM
MOVEI E,0(A) ;BYTE SIZE GOES IN E WITH MODES 0
TRO Z,1 ;SAY MODE 0
RET
.IMAGE: KEYWD $IMAGE
TE ,,400
JRST CERR
JRST ASCII1
$IMAGE: TABLE
TE BINARY,,4000
TEND
.RECOR: NOISE (length)
JRST NIYE
;$OPEN7 $OPENF $OPNER
;OPEN FILE SUBROUTINE
;DOES OPENF, RETURNS ON SUCCESS, GIVES MESSAGE ON FAILURE
;CALL WITH A & B SET UP FOR "OPENF" JSYS.
;CHECKS FOR AND DOES NOT RE-OPEN PRI I/O FILES
; (PRI FILES ARE SOMETIMES DEFAULT ARG VALUES).
$OPEN7: HRLI B,<7B5+0B9>B53 ;ENTER HERE FOR 7 BIT BYTES NORMAL MODE
$OPENF: CAME A,CIJFN ;REGULAR ENTRY
CAMN A,COJFN
RET ;DON'T TRY TO OPEN PRI FILES AGAIN
PUSH P,A ;SAVE JFN FOR USE IN ERROR MESSAGE
OPENF ;OPEN FILE
CALL $OPNER ;ERROR, # IN A, SAVE PC FOR JERR.
POP P,A ;SUCCESS, RETURN TO CALLER.
RET
$OPNER: MOVE C,-1(P) ;RETRIEVE JFN FOR %S
CAIN A,OPNX13
ERROR <Access to %3S denied>
CAIN A,OPNX3
ERROR <Read protect violation for file %3S>
CAIN A,OPNX4
ERROR <Write protect violation for file %3S>
CAIN A,OPNX6
ERROR <%3S can't be appended to>
CAIN A,OPNX7
JRST [ MOVE A,C
DVCHR
HLRZ C,C
UERR [ASCIZ /%1H: is assigned to job %3Q/]]
CAIN A,OPNX8
ERROR <%3H: not mounted>
CAIN A,OPNX9
JRST [ TRNN B,1B18!1B20!1B21!1B22!1B23!1B24 ;READ ONLY OPENF
TROE B,1B25 ;HAVING ALREADY TRIED THAWED?
ERROR <file %3S busy> ;ANNOUNCE ERROR
SUB P,[1,,1] ;FLUSH ERROR PC
POP P,A ;RETREIVE JFN
JRST $OPENF] ;AND TRIED IN THAWED MODE
CAIN A,OPNX10
ERROR <No room in system for another open file>
JRST JERR ;GO TO GENERAL JSYS ERROR ROUTINE
;LIST/TYPE <FILE GROUP DESCRIPTOR>
;FLAGS USED, IN AC F
;B0 "PRINTER WATCH ON"
;B1 SITE INCLUDED IN HEADING
;B2 INDICATE NULLS BY ↑@
;B3 NO PAGE NUMBERS
;B4 SUPPRESS PRINTING/CHARACTER POSITION ACCOUNTING (SKIPPING PAGES)
;B5 LAST LINE SCANNED WAS COMMENT
;B6 LAST LINE SCANNED WAS NOT COMMENT
;B7 LAST CHAR LF OR EOL AND SPACING GREATER THAN 1
;B8 LAST CHAR WAS LINE OVERFLOW EOL
;B9 LAST CHAR WAS CONTROL CHAR TO INDICATE WITH ↑X (LOCAL TO GETC)
;B10 SUPPRESS PRINTING (WHEN PASSING EOLS & ↑LS AT BOTTOM OF PAGE)
;B11 EOF HAS BEEN ENCOUNTERED IN INPUTTING TO INPUT BUFFER
;B12 EOF HAS BEEN ENCOUNTERED IN READING FROM INPUT BUFFER
;B13 LAST CHR WAS EOL, OUTPUT AN LF THIS TIME
;B14 PAUSE BEFORE EACH PAGE
;B15 SOURCE IS TTY, TERMINATE ON ↑Z
;B16 DETACH BEFORE LISTING
;B17 LOGOUT AFTER LISTING
;B18 VERBATIM FILE OUTPUT, NO CONTROL CHARACTER INDICATION
;B19 SET WHEN ANY DATA IS REALLY WRITTEN INTO THE OUTPUT FILE
;LIST/TYPE... STORAGE
;IN XPRIV.MAC:
;GHEAD 0 OR BYTE POINTER TLSUBCOMMAND-GIVEN HEADING
;HEAD 0 OR PTR TO HEAD BEING USED FOR THIS FILE, INCL "PAGE "
;HEDLNO # LINES IN HEADING, INCL EOLS BEFORE AND AFTER
;SPCG 0 FOR SINGLE SPACING, 1 FOR DOUBLE, ETC
;WIDTH PAGE WIDTH IN COLUMNS
;LENGTH PAGE LENGTH IN LINES
; = LAST LINE AT WHICH TO BREAK PAGE IF NO ↑L
;L35 FIRST LINE AT WHICH TO BREAK PAGE IN ABSENCE OF ↑L
;L50 PREFERRED LINE AT WHICH TO BREAK PAGE
;PAGENO PAGE NUMBER, INCREMENTED AT ↑L
;PAGEN1 SUBPAGE NUMBER, INCREMENTED WHEN OVERLONG PAGE IS SPLIT
;BESPTR POINTER TO BEST PLACE IN OUTBUF YET SEEN TO BREAK PAGE
;BESCOR "SCORE" ASSOCIATED WITH BESPTR
;BESLNO LINE # AT BESPTR
;PPRINT POINTER TO BLOCK OF WORDS SPECIFYING PAGES TO LIST,
;EACH WORD BEING MIN,,MAX, 0 TERMINATING BLOCK.
;THE PAGE BUF1 (DEFINED IN XDEF.MAC) IS INPUT BUFFER
INBUF==BUF1
INBUFL==<BUF1+1000-INBUF>*5-1 ;LENGTH, LEAVING SPACE FOR NULL
;OUTPUT BUFFER IS BUF2 AND FOLLOWING PAGES
;AC'S
;CHR (DEFINED IN XDEF) ;CHARACTER READ FROM INBUF
;CNO AND LNO SPECIFY POSITION ON PAGE OF LAST CHARACTER IN OUTBUF
CNO==BB ;COLUMN NUMBER ON LINE
LNO==CC ;LINE NUMBER ON PAGE
INPTR==DD ;BYTE PTR TO INPUT BUFFER
OUTPTR==EE ;BYTE PTR TO OUTPUT BUFFER
;CNT (DEFINED IN XDEF) ;NUMBER OF CHARACTERS REMAINING IN INBUF
GBGPCT==↑D20 ;PERCENT CONTROL CHRS IN FIRST PAGE OF FILE ABOVE WHICH
; THE FILE IS CONSIDERED TO BE GARBAGE
;.TYPE .LIST LIST1 LIST01
;LIST/TYPE
.TYPE: MOVE A,['E TYPE']
SETNM
MOVE A,COJFN
MOVEM A,OUTDSG
JRST LIST1
.LIST: MOVE A,['E LIST']
SETNM
CALL $LPT ;USE A "DIRECTORY" SUBCOMMAND ROUTINE TO
;ASSIGN A JFN TO LINE PRINTER
MOVEI A,↑D132
MOVEM A,WIDTH
JRST LIST01
LIST1: SETOM WIDTH ;INDICATE WIDTH UNSPECIFIED
LIST01: NOISE (file)
SETZ F, ;CLEAR FLAGS
SETZM GHEAD
SETZM SPCG
SETOM LENGTH ;INDICATE LENGTH UNSPECIFIED
MOVEI A,[1,,777777
0]
MOVEM A,PPRINT
CALL $INFG ;INPUT FILE GROUP
JRST [ ;R1: SUBCOMMANDS REQUIRED
CONFIRM
SUBCOM $LIST
JRST .+2]
CONFIRM
;LIST1D
;LIST/TYPE... PRE-FIRST-FILE INITIALIZATION
;OPEN OUTPUT FILE
MOVE A,OUTDSG
MOVEI B,1B20
CALL $OPEN7
;NOW THAT "[LPT: BUSY-GO]" HAS BEEN PRINTED,
;DETACH IF REQUESTED BY SUBCOMMAND
TLNN F,B16
JRST LIST1D
ETYPE < Detaching job %J
>;
DTACH
LIST1D:
;USE ACTUAL LENGTH AND WIDTH OF OUTPUT DEVICE IF NOT SPECIFIED
; BY USER WITH "LENGTH" AND "WIDTH" SUBCOMMANDS
MOVE A,OUTDSG
RFMOD
LDB A,[POINT 7,B,17] ;GET WIDTH
CAIGE A,↑D15 ;REASONABLE (LESS SCREWS TITLE SETUP)
MOVEI A,377777 ;NO. 0 MEANS INFINITY (NO FOLDING)
SKIPGE WIDTH ;SKIP IF SPECIFIED BY SUBCOMMAND
MOVEM A,WIDTH ;STORE DEVICE WIDTH
LDB A,[POINT 7,B,10] ;GET OUTPUT DEVICE PAGE LENGTH
CAIGE A,↑D10 ;REASONABLE?
MOVEI A,↑D66 ;NO, USE COMMON DEFAULT
IMULI A,↑D10 ;LEAVE 1/11 PAGE LENGTH FOR MARGINS
IDIVI A,↑D11
SKIPGE LENGTH ;SKIP IF SPECIFIED BY SUBCOMMAND
MOVEM A,LENGTH ;STORE PAGE LENGTH
;DETERMINE LINE "35"=FIRST LINE AT WHICH PAGE BREAK CAN OCCUR
MOVE B,LENGTH ;PAGE LENGTH, PERHAPS CHANGED FROM 60
IMULI B,↑D8 ;...BY SUBCOMMAND
IDIVI B,↑D12
MOVEM B,L35
;DETERMINE LINE "50"=OPTIMUM PAGE BREAK POINT (NOW ACTUALLY 55)
MOVE B,LENGTH
IMULI B,↑D11
IDIVI B,↑D12
MOVEM B,L50
JRST LSTFL ;JUMP AROUND SUBCMD STUFF
;$LIST ..DETA ..DOUB
;LIST/TYPE SUBCOMMAND TABLE AND ROUTINES
$LIST: TABLE
TE DETACH,LPROK+INVIS,..DETA
T DOUBLESPACE,ONEWD+INVIS,..DOUB
TE HEADING
T INDICATE,LPROK+EOLOK+ALTCON,..INDI
T LENGTH,,..LENG
TE LOGOUT,LPROK+INVIS,...LOG
TE NO,LPROK,...NO
T OUTPUT,CONMAN+LPROK,..OUTP
T PAGES
TE PAUSE,LPROK
TE SITE,LPROK,..SITE
T SPACING
T VERBATIM,ONEWD,...VRB
; TE WATCH,,..WATC
T WIDTH
TEND
..DETA: NOISE (before listing)
CONFIRM
TLO F,B16
RET
..DOUB: MOVEI A,1
JRST SPAC2
;.HEADI HEADI1
;LIST/TYPE SUBCOMMANDS...
;HEADING: TAKE TEXT TO CR OR ALT MODE, COMMENT OK AFTER ALT MODE,
;CR TERMINATING "HEADING" MEANS NONE.
;CARRIAGE RETURNS CAN BE PUT IN HEADING WITH ↑V OR &.
.HEADI: MOVE A,[POINT 7,[0]]
TRNE CBT,TEOL
JRST [ CONFIRM
JRST HEADI1]
CALL CSTR
CAIN TRM,FORMF
JRST .+5
CAIE CHR,EOL
CAIN CHR,ALTM
JRST .+2
JRST MORE
ALTYPE ( )
CONFIRM
;COPY TEXT TO CSBUF: CAN'T USE "BUFFF" CAUSE IT CHANGES CONTCH
;TO SPACE, LOWER CASE TO UPPER, HAS LENGTH LIMIT.
MOVE A,CSBUFP
MOVE B,.BFP
MOVE C,CNT
SOJLE C,.+3
ILDB D,B
IDPB D,A
SOJG C,.-2
SETZ C,
IDPB C,A
EXCH A,CSBUFP
HEADI1: MOVEM A,GHEAD
RET
;..INDI ..LENG ...LOG ...NO ..OUTP
;LIST/TYPE SUBCOMMANDS...
..INDI: UNOI [ASCIZ /nulls by ↑@/]
ALLOW TSPC+TALT+TEOL
CONFIRM
TLO F,B2
RET
..LENG: NOISE (of page is)
CALL DECIN
JRST CERR
ALLOW TALT+TSPC+TEOL
CAIG A,↑D10
JRST CERR
CONFIRM
MOVEM A,LENGTH
RET
...LOG: NOISE (after listing)
CALL INFER
JRST .+2
ERROR <Not legal in inferior EXEC>
CONFIRM
TLO F,B17
RET
...NO: NOISE (page numbers)
CONFIRM
TLO F,B3
RET
..OUTP: NOISE (to file)
MOVE A,[2,,[ASCIZ /LST/]] ;DEFAULT: SOURCE NAME, .LST
CALL COUTFN
JRST CERR
ALLOW TALT+TSPC+TEOL
CONFIRM
MOVEM A,OUTDSG
RET
;.PAGES PAGE1 PAGE2
;LIST/TYPE SUBCOMMANDS...
;PAGES N,N-N,N-N,N...
;EACH NUMBER MUST BE GREATER THAN OR EQUAL TO LAST
.PAGES: MOVEI D,1 ;LARGEST NUMBER YET SEEN
AOS B,CSBUFP ;BUILD BLOCK OF MIN,,MAX IN STRING BUFFER
PAGE1: TLO Z,DASHF ;MAKES "-" A FIELD TERMINATOR
CALL DECIN
JRST CERR
CAIL A,(D)
CAILE A,-1
JRST CERR
HRL C,A
MOVE D,A
CAIE TRM,"-"
JRST PAGE2
CALL DECIN
JRST CERR
CAIL A,(D)
CAILE A,-1
JRST CERR
MOVE D,A
PAGE2: HRR C,A
MOVEM C,(B)
TRNE CBT,TCOM
AOJA B,PAGE1
ALLOW TALT+TSPC+TEOL
TLZ Z,DASHF
ALLOW TALT+TSPC+TEOL
CONFIRM
SETZM 1(B) ;0 ENDS BLOCK
ADDI B,2
EXCH B,CSBUFP
HRRZM B,PPRINT
RET
;.PAUSE .SPACI SPAC2 ..SITE ...VRB .WIDTH
;LIST/TYPE SUBCOMMANDS...
.PAUSE: NOISE (before each page)
CONFIRM
TLO F,B14
RET
.SPACI: CALL DECIN
JRST CERR
ALLOW TALT+TSPC+TEOL
SOJL A,CERR ;STORE SPACING - 1
CAIL A,10
JRST CERR
SPAC2: CONFIRM
MOVEM A,SPCG
RET
..SITE: NOISE (in heading)
CONFIRM
TLO F,(1B1)
RET
...VRB: CONFIRM
TRO F,1B18 ;SUPPRESS CONTROL INDICATON
RET
;..WATC: NOISE (for printer completion)
; CONFIRM
; TLO F,(1B0)
; RET
;
.WIDTH: CALL DECIN
JRST CERR
ALLOW TALT+TSPC+TEOL
CAIG A,↑D15 ;LESS SCREWS UP TITLE SETUP CODE
JRST CERR
CONFIRM
MOVEM A,WIDTH
RET
;LSTFL
;LIST/TYPE...
;HERE TO LIST NEXT FILE IN LIST
LSTFL: MOVE A,OUTDSG ;OUTPUTTING TO CONTROL TTY?
CAME A,COJFN
TLNE F,B16 ;OR DETACHING?
CAIA ;YES, DON'T TYPE FILENAME
CALL TYPIF ;NO, TYPE FILENAME IF MULTIPLE
TLZ F,B4+B5+B6+B7+B8+B9+B11+B12+B13+B15
;OPEN INPUT FILE
HRRZ A,@INIFH1
MOVEI B,1B19
CALL $OPEN7
;SET ↑Z FLAG IF TTY
DVCHR
LDB E,[POINT 9,B,17] ;DEVICE TYPE IN E USED FOR HEADING BELOW
CAIN E,12
TLO F,B15
;LSTH1B
;LIST/TYPE... SET UP HEADING
SETZ CNO, ;WILL BE USED TO ACCOUNT SPACES AND EOLS IN HEDG
MOVEI LNO,1 ;START # LINES AT 1 TO ALLOW FOR EOL BEFORE HEDG
SKIPE INPTR,GHEAD
JRST LSTH2 ;HAVE SUBCOMMAND-GIVEN HEADING
;SET UP DEFAULT HEADING: FILE NAME AND DATE & TIME
MOVE A,CSBUFP
ADDI A,40 ;ADD 40 CAUSE ITS WRITTEN OVER BELOW,
MOVE INPTR,A ;INSERTED EOLS MAY CAUSE WIDTH OVERFLOW
CALL COMCHR ;OUTPUT THE COMMENT CHARACTER
MOVEI B," "
BOUT
BOUT
TLNE F,(1B1) ;CHECK "SITE" BIT
CALL SITEO ;OUTPUT SITE ON A
HRRZ B,@INIFH1
MOVE C,[2B2+1B5+1B8+1B11+1B14+1]
JFNS
HRROI B,[ASCIZ / /]
SETZ C,
SOUT
;DATE: WRITE DATE OF DISC FILE TO WHICH WE HAVE LIST ACCESS,
;ELSE CURRENT.
SETO B, ;SAYS "CURRENT" TO ODTIM
JUMPN E,LSTH1B ;JUMP IF NON-DISC
;GET WRITE DATE
PUSH P,A
HRRZ A,@INIFH1
MOVE B,[1,,FDBWRT]
MOVEI C,B
CALL $GTFDB ;DO GTFDB JSYS, NO SKIP IF NO ACCESS
SETO B, ;NO ACCESS, USE CURRENT
POP P,A
LSTH1B: HRLZI C,B1+B10+B11+B17 ;ODTIM FORMAT
ODTIM
SETZ CNT, ;BUT TELL "GETC" ITS INFINITELY SHORT
; (ALSO BECAUSE ITS NULL TERMINATED)
;LSTH2 LSTH2A LSTH2D
;LIST/TYPE SETTING UP HEADING...
;SCAN HEADING STRING, COUNTING EOL'S (FOR EFFECT ON PAGE SIZE) AND
;COLUMNS USED (SO PAGE NUMBER CAN BE POSITIONED AT RIGHT).
;USE FAKED-UP CALLS TO FILE CHAR READER "GETC".
;"INPTR" NOW POINTS TO STRING.
LSTH2: TLO F,B11
MOVE OUTPTR,CSBUFP
MOVEM OUTPTR,HEAD
SETZ CNT, ;TELL GETC ITS TERMINATED BY FIRST NULL
LSTH2A: CALL GETC ;READ CHARACTER
CAIE CHR,CONTCH ;CHANGE CONTINUATION CHARACTER & TO CRLF
JRST LSTH2D
MOVEI B,CR
DPB B,OUTPTR ;OVERWRITE THE "&"
MOVEI B,LF
IDPB B,OUTPTR
SETZ CNO,
MOVEI LNO,1(LNO)
LSTH2D: CAIE CHR,200 ;END OF STRING ?
JRST LSTH2A
;SPACE OVER AND ADD " PAGE " IF PAGES ARE TO BE NUMBERED
MOVE A,OUTPTR
TLNE F,B3
JRST LSTH4 ;PAGE NUMBERS SUPPRESSED
MOVE C,WIDTH
SUBI C,↑D14 ;SPACE FOR " PAGE NNN:NNN"
SUB C,CNO
CAILE C,↑D128 ;WIDTH IS INFINITY?
MOVEI C,↑D10 ;YES, USE SOMETHING MORE MODEST
JUMPLE C,[MOVEI B,CR ;ALREADY TOO FAR RIGHT, START WITH CRLF
DPB B,A
IBP A
MOVEI B,LF
MOVEI LNO,1(LNO)
ADD C,CNO
AOJA C,.+2]
MOVEI B," "
SUBI C,5 ;MOVE LEFT 5 MORE COLUMNS IF POSSIBLE.
;THIS MAKES 2-DIGIT PAGE NUMBER LINE UP NICELY
;OVER 72-COL TEXT WHEN WIDTH IS 80
;(NORMAL CASE TO LPT:)
MOVEI CHR," "
DPB B,A ;STORE FIRST CHAR OVER NULL
IDPB CHR,A
SOJG C,.-1
HRROI B,[ASCIZ /Page /]
SETZ C,
SOUT
;LSTH4 LSTH8 LSTIGE LSTGCK LSTGCE
;LIST/TYPE...
;TERMINATE HEADING STRING AND SAVE THINGS
LSTH4: SETZ CHR,
IDPB CHR,A
;DO NOT SAVE END PTR - REUSE SPACE FOR NEXT FILE
MOVE A,HEAD
ILDB A,A ;SEE IF HEADING NULL
JUMPE A,[SETZM HEAD ;IF SO, SAY SO (SUPPRESSES EOLS AFTER)
JRST LSTH8] ;DON'T ACCOUNT EOLS AFTER
MOVEI LNO,3(LNO) ;ALLOW FOR EOL'S AFTER HEADING
ADD LNO,SPCG
LSTH8: MOVEM LNO,HEDLNO ;NUMBER OF LINES USED BY HEADING AND EOLS
TLZ F,B11+B12
;REST OF PER-FILE INITIALIZATION
;EOF PSI DISPATCH
MOVEI A,LSTEOF
MOVEM A,EOFDSP
;INIT CHARACTER POSITION, PAGE #, BUFFERS, ETC
SETZB LNO, BESLNO
SETZB CNO,PAGEN1
MOVEI A,1
MOVEM A,PAGENO
MOVE INPTR,[POINT 7,[0],-1] ;NO TEXT IN INBUF
SETZ CNT, ;..
MOVEM INPTR,BESPTR ;NO TEXT SAVED FROM LAST PAGE
MOVE OUTPTR,[POINT 7,BUF1] ;JUST FOR SAFETY
;PASS EOLS AT BEGINNING OF FILE
TLO F,B4
LSTIGE: CALL GETC
CAIE CHR,LF
CAIN CHR,CR
JRST LSTIGE
;CAIE CHR,FF
CAIN CHR,EOL
JRST LSTIGE
;200 FOR EOF REMAINS IN CHR TIL TITLE IS PRINTED
;SCAN TEXT IN FIRST BUFFERFUL AND CHECK FOR UNREASONABLE CONCENTRATION
; OF OF CONTROL CHARACTERS
TLNN F,B15 ;OMIT CHECK IF SOURCE IS TTY
CAIG CNT,↑D200 ;OMIT CHECK FOR VERY SHORT FILES
JRST LSTGCE
MOVE A,INPTR ;INITIAL BYTE PTR
MOVE C,CNT ;COUNT OF CHARS IN BUFFER
SETZ D, ;INIT CONTROL CHAR COUNT
LSTGCK: ILDB B,A ;GET CHAR FROM BUFFER
CAIL B,40 ;SKIP IF A CONTROL CHARACTER
JRST .+4 ;NOT, CONTINUE
CAIL B,10 ;DON'T COUNT ↑H THRU ↑M
CAILE B,15
JRST [ SKIPE 0(A) ;WHOLE WORD NULL?
JUMPE CHR,.+1 ;NO, DON'T COUNT NULL CHR
AOJA D,.+1] ;COUNT IF WORD NULL OR CHR NON-NULL
;;;NB: THIS REALLY SHOULD NOT APPLY IF THIS CONTROL CHARACTER
;;; WAS PRECEEDED BY A LINE PRINTER GRAPHIC QUOTE. THIS IS
;;; 177 FOR ANELEX, AND SOME OTHERS.
SOJG C,LSTGCK ;REPEAT FOR ALL CHARACTER IN BUFFER
IMULI D,↑D100/GBGPCT ;CHECK FOR GT GBGPCT % CONTROL CHARAS
CAMG D,CNT
JRST LSTGCE ;FILE IS OK, CONTINUE
HRRZ A,@INIFH1 ;TOO MANY, COMPLAIN
ETYPE < [File %1S contains excessive control characters
and does not look like a text file. Type CR to print it anyway, or
rubout to bypass it]>
BTCHER ;THIS IS AN ERROR UNDER BATCH
CALL TCONF ;REQUIRE CONFIRMATION FROM USER
JRST LIST8 ;NOT CONFIRMED, BYPASS THIS FILE
LSTGCE: CALL GETC4 ;ACCOUNT FOR CHAR TO BE PRINTED
JRST LSTTOP ;SKIP SKIPPER
;LSKIP
;LIST/TYPE... SKIP PAGE
LSKIP: TLO F,B4 ;SUPPRESS PRINTING AND ACCOUNTING
;IGNORE CARRY-OVER TEXT. IT CAN'T CONTAIN A SIGNIFICANT ↑L,
;INDEED I THINK IT CAN'T BE NON-NULL.
;SCAN TO ↑L.
CALL GETC ;GET CHAR FROM INBUF
CAIN CHR,200
JRST LIST8 ;EOF, DONE LISTING
CAIE CHR,FORMF
JRST .-4
;SCAN PAST IMMEDIATELY FOLLOWING EOLS & ↑L'S -- THEY'RE
;PART OF SAME PAGE.
CALL GETC
CAIE CHR,CR
CAIN CHR,LF
JRST .-3
CAIE CHR,EOL
CAIN CHR,FORMF
JRST .-6
CAIN CHR,200
JRST LIST8 ;EOF, DONE LISTING
SETZB LNO,BESLNO
SETZ CNO,
MOVE A,[POINT 7,[0],-1]
MOVEM A,BESPTR ;EMPTY TEXT CARRIED OVER FROM PREVIOUS PAGE
AOS PAGENO
;FALL INTO LSTTOP, FIRST CHAR OF PAGE IN "CHR"
;LSTTOP LSP2A LSTP2B LSTP2C
;LIST/TYPE... TOP OF PAGE LOOP. DETERMINE WHETHER PAGE WILL PRINT.
LSTTOP: HLRZ A,@PPRINT ;MIN OF GROUP OF PAGES TO PRINT
JUMPE A,LIST8 ;END OF PAGES TO PRINT BLOCK, DONE THIS FILE
CAMLE A,PAGENO
JRST LSKIP ;SKIP PAGE
HRRZ A,@PPRINT ;MAX OF SAME GROUP
CAMGE A,PAGENO
JRST [ AOS PPRINT ;BEYOND THIS GROUP, GET NEXT
JRST LSTTOP]
TLZ F,B4 ;WILL PRINT, TURN ON PRINTING.
TRO F,1B19 ;SAY THAT SOME OUTPUT HAS BEEN GENERATED
;PRINT PAGE. FIRST HEADING AND PAGE NUMBER
TLNE F,B14
JRST [ ;PAUSE BEFORE EACH PAGE REQUESTED
PRINT BELL ;RING CONTROLLING TTY BELL
MOVE A,CIJFN
BIN ;USER SHOULD TYPE EOL
MOVE A,COJFN
JRST LSP2A]
MOVE A,OUTDSG
MOVEI B,CR
BOUT
MOVEI B,LF
BOUT
LSP2A: SETZ C,
MOVE B,HEAD ;HEADING STRING, INCL "PAGE "
JUMPE B,LSTP2C ;NO HEADING OR PAGE #'S AT ALL
SOUT
TLNE F,B3
JRST LSTP2B ;NO PAGE #
MOVE B,PAGENO
MOVEI C,↑D10
NOUT ;PAGE NO
CALL JERRC
SKIPN PAGEN1
JRST LSTP2B
MOVEI B,":"
BOUT
MOVE B,PAGEN1
NOUT
CALL JERRC
LSTP2B: MOVEI B,CR
BOUT
MOVEI B,LF
MOVE C,SPCG
ADDI C,3 ;SPACING + 2 EOLS
BOUT
SOJG C,.-1
LSTP2C: ADD LNO,HEDLNO ;ACCOUNT LINES IN TITLE, INCL EOLS B4 AND AFTER
;LSTCL LSTCL1 LSTCL2
;LIST/TYPE... PRINT TEXT CARRIED FORWARD FROM PREVIOUS PAGE
;(NULL IF PREVIOUS PAGE NOT LISTED OR ↑L FOUND, BUT NON-NULL AFTER
;OVERLONG PAGE BROKEN AT BEST POINT)
;MOVE A,OUTDSG
MOVE B,CHR
CAIE CHR,200 ;NULL FILE CASE EOF
BOUT ;THE FIRST CHARACTER OF PAGE IS IN "CHR"
MOVE B,BESPTR ;POINTER TO UNOUTPUT TEXT IN OUTPUT BUFFER
SETZ C,
SOUT
;INIT TO DO PAGE
SUB LNO,BESLNO ;REDUCE LINE # BY # LINES PRINTED ON LAST PAGE
;THIS SHOULD LEAVE LNO SET TO NUMBER OF EOLS
;IN TEXT JUST PRINTED
MOVE OUTPTR,[POINT 7,BUF2,-1] ;WHERE TO STORE TEXT TO BE OUTPUT
MOVNI B,B0 ;SET SCORE OF BEST PLACE YET SEEN TO BREAK
MOVEM B,BESCOR ;PAGE TO MINUS INFINITY
MOVEM OUTPTR,BESPTR ;JUST IN CASE
MOVEM LNO,BESLNO ;...
TLZ F,B5+B6 ;DON'T KNOW WHETHER LAST LINE WAS COMMENT OR NOT
;CHARACTER LOOP.
;CHARACTERS ARE READ AND BUFFERED.
;EOLS AFTER LINE "35" ARE SCORED AS POSSIBLE PAGE BREAK POINTS;
;PRINTING DOES NOT OCCUR TIL ↑L OR "60"TH EOL.
LSTCL: CALL GETC
LSTCL1: CAIE CHR,200 ;EOF
CAIN CHR,FORMF ;↑L
JRST LSPFF ;GO PRINT TO HERE
CAIE CHR,EOL
CAIN CHR,LF
JRST .+2 ;END OF LINE
JRST LSTCL ;ANY OTHER CHAR, LOOP.
;HAVE EOL
CAML LNO,L35
JRST LSTCL2
MOVEM OUTPTR,BESPTR ;SAVE AS A BREAK POINT IN CASE NO
MOVEM LNO,BESLNO ;...LINES BETWEEN "35" AND "60" DUE TO
JRST LSTCL ;...SMALL LENGTH AND LARGE SPACING
;HAVE AN EOL BEYOND LINE "35". IF BEYOND "LENGTH", PRINT.
LSTCL2: CAMLE LNO,LENGTH ;OFF BOTTOM OF PAGE?
JRST LSPNFF ;YES, PRINT TO HIGHEST-SCORING BREAK SEEN
;LSTC3A LSTC3B LSTC3C
;LIST/TYPE... HAVE EOL, SCORE BREAK AT THIS POINT
PUSH P,OUTPTR
PUSH P,LNO
;WIDTH OVERFLOW FORCED EOL: BASIC SCORE IS -200
TLNE F,B8
JRST [ HRROI E,-↑D200
CALL GETC
JRST LSTC3X]
SETZ E, ;INITIALIZE SCORE
;SCAN PAST EOLS & BLANKS, SCORING +10 PER EOL,
;-1 PER COLUMN INDENTATION
LSTC3A: CALL GETC
CAIN CHR,CR
JRST LSTC3A
CAIE CHR,LF
CAIN CHR,EOL
JRST [ ADDI E,↑D10
TLZ F,B5 ;IMMEDIATELY PRECEDING LINE NOT COMMENT
JRST LSTC3A]
CAIE CHR,200 ;EOF
CAIN CHR,FORMF ;FORM FEED AFTER EOL(S)
JRST [ POP P,BESLNO ;PRINT TO BEFORE THE EOLS (WHICH MIGHT
POP P,BESPTR ;HAVE CROSSED PAGE LENGTH)
JRST LSPFF1]
JRST .+2
LSTC3B: CALL GETC ;AFTER SPACE-TAB DON'T CHECK FOR FF: IF BEYOND
;PAGE LENGTH THEN ITS ON NEXT PAGE.
CAIN CHR," "
SOJA E,LSTC3B
CAIN CHR,TAB
JRST [ SUBI E,10
JRST LSTC3B]
;NOW IF WE ARE AT LEFT MARGIN, ADJUST FOR COMMENTS
CAILE CNO,1
JRST LSTC3D
CAIN CHR,"!"
JRST LSTC3C
CAIE CHR,"$" ;FOR FORTRAN
CAIN CHR,"/" ; " "
JRST LSTC3C
CAIE CHR,";"
CAIN CHR,"*"
LSTC3C: JRST [ TLZE F,B6
ADDI E,↑D50 ;+50 IF PREVIOUS LINE NO COMMENT
TLOE F,B5 ;-20 IF LAST LINE WAS COMMENT, TO AVOID
SUBI E,↑D20 ;BREAKING UP BLOCKS OF COMMENTS
JRST LSTC3X]
;-100 FOR ), ] AT LEFT MARGIN, FOR LISP PRETTYPRINT LISTINGS
CAIE CHR,")"
CAIN CHR,"]"
SUBI E,↑D100
;LSTC3D LSTC3X
;LIST/TYPE... SCORING BREAK AT EOL...
;IF HERE, THIS LINE WAS NOT COMMENT AT LEFT MARGIN
LSTC3D: TLZ F,B5
TLO F,B6
;NOW REDUCE ALL SCORES BY # LINES AWAY FROM "50"
LSTC3X: MOVE A,L50
SUB A,(P) ;LNO SAVED BEFORE SCANNING PAST EOLS
MOVM A,A
SUB E,A
;UPDATE BEST BREAK SEEN IF THIS ONE IS BETTER
CAML E,BESCOR
JRST [ POP P,BESLNO ;THIS ONE IS BETTER
POP P,BESPTR
MOVEM E,BESCOR
JRST .+2]
SUB P,[2,,2]
JRST LSTCL1
;LSPNFF LSPFF LSPFF1 LSTP1 LSTP15
;PRINT PAGE
;NO FORM FEED, PRINT TO BEST BREAK SEEN
LSPNFF: AOS PAGEN1
JRST LSTP1
;FORM FEED OR EOF, PRINT TO HERE
LSPFF: CAML LNO,LENGTH ;IF BEYOND BOTTOM OF PAGE,PRINT INSTEAD
JRST LSPNFF ;TO BEST PRECEDING BREAK
MOVEM OUTPTR,BESPTR ;MAKE THIS POINT THE BEST BREAK SEEN
MOVEM LNO,BESLNO ;..
LSPFF1: AOS PAGENO ;FF AFTER EOL JOINS HERE (LSTC3A)
SETZM PAGEN1
;PRINT OUTBUF TO BESPTR EXCEPT THE FINAL EOL OR FF
LSTP1: MOVE A,BESPTR
BKJFN ;BACK UP ONE CHARACTER
CALL JERR
MOVEM A,BESPTR
MOVE D,BESPTR
ILDB E,D ;GET CHAR AFTER BEST BREAK
CAIE E,LF
CAIN E,EOL
SOS BESLNO ;UNACCOUNT FOR BACKUP
CAIE E,LF ;ON LF BACK UP OVER PRECEDING CR
JRST LSTP15 ;NOT A LF
LDB A,A ;GET CHR JUST BEFORE LINEFEED
CAIN A,CR
JRST LSTP1 ;GO BACK UP AGAIN
LSTP15: LDB A,[POINT 6,D,5] ;NUMBER OF BITS LEFT IN LAST WORD
IDIVI A,7 ;NUMBER OF CHRS
MOVEI C,BUF2-1 ;BEG OF OUTPUT BUF MINUS 5 CHRS
SUBI C,0(D) ;NUMBER OF FULL AND PARTIAL WORDS
IMULI C,5 ;NUMBER OF CHRS THEREIN
ADDI C,1(A) ;NEG CHR CNT (NOT INC. CHR AT "BESPTR")
JUMPGE C,LSTP19 ;NO CHAR'S TO BE OUTPUT
MOVE A,OUTDSG
HRROI B,BUF2
SOUT ;PRINT
;LSTP19 LSTP2
;LIST/TYPE... PRINT PAGE...
;AFTER PRINTING PASS EOLS AND ↑L'S, PRINTING THOSE THAT WILL FIT PAGE,
;THEN SEND A REAL FORM FEED.
LSTP19: TLZ F,B10 ;PERMIT PRINTING
LSTP2: MOVE A,OUTPTR
SETZ C,
IDPB C,A ;TERMINATE OUTBUF
CALL GGETC ;GET CHR FROM OUTPUF IF NOT ALL USED UP,
;ELSE FROM INBUF
MOVE A,OUTDSG
SETZ C,
CAIN CHR,FORMF
JRST [ HRROI B,[ASCIZ /↑L/]
TLNN F,B10
SOUT
JRST LSTP2]
CAIN CHR,CR
JRST [ MOVE D,BESLNO
AOJA D,[CAML D,LENGTH ;IS PAGE TOO FULL FOR LF AFTER?
TLO F,B10 ;YES, SUPPRESS PRINTING
MOVE B,CHR
TLNN F,B10
BOUT
JRST LSTP2]]
CAIE CHR,EOL
CAIN CHR,LF
JRST [ AOS D,BESLNO
JRST [ CAML D,LENGTH ;PAGE FULL?
TLO F,B10 ;YES, SAY NO PRINT
MOVE B,CHR
TLNN F,B10
BOUT
JRST LSTP2]]
IDPB C,OUTPTR ;TERMINATE CARRY-OVER TEXT
MOVEI B,FORMF
BOUT ;REAL FORM FEED
CAIE CHR,200 ;EOF ?
JRST LSTTOP ;NO, GO DO NEXT PAGE, ITS 1ST CHAR IN "CHR"
;LIST8 LIST9 LIST91
;LIST/TYPE...
;END-OF-FILE HAS BEEN PROCESSED
LIST8: CALL GNFIL ;GET NEXT FILE IN INPUT GROUP
JRST LIST9 ;R1: NO MORE
JRST LSTFL ;R2: HAVE IT, GO BACK AND LIST IT.
;ALL DONE LISTING FILES
LIST9: TRNN F,1B19 ;IF NO OUTPUT WAS ACTUALLY GENERATED
JRST [ MOVE A,OUTDSG ;ATTEMPT TO DELETE THE (EMPTR) OUT FILE
DELF
JFCL
JRST LIST91] ;BYPASS EXTRA EOL AND PRINTER WATCH ON
;SEND ONE LAST EOL (NOT DONE EXCEPT AFTER LAST FILE
;BECAUSE IN OTHER CASES NEXT PAGE BEGINS WITH EOL OR PAUSE)
MOVE A,OUTDSG
MOVEI B,CR
BOUT
MOVEI B,LF
BOUT
; TLNE F,(1B0) ;"WATCH"
; SETZM PRNTIM ;YES, ENABLE CHECKING
;UNMAP STORAGE PAGES
LIST91: CALL UNMDIR ;SUBROUTINE IN X3CMD.MAC THAT UNMAPS PAGES
;BUF1 TO 767.
;RELEASE JFNS
CALL RLJFNS
;IF REQUESTED BY SUBCOMMAND, GO LOGOUT
TLNN F,B17
JRST CMDIN4 ;GO BACK TO COMMAND INPUT (NORMAL CASE)
SETO A, ;LOGOUT
LGOUT
CALL JERR
;GGETC GETC
;LIST/TYPE SUBROUTINES
;GGETC
;GET CHAR FROM OUTBUF CARRY-OVER (BESPTR) IF ANY, ELSE FROM INPUT FILE.
;CLOBBERS A-D
GGETC: MOVE A,BESPTR
ILDB CHR,A
JUMPN CHR,[MOVEM A,BESPTR
RET]
;OUTBUF EMPTY, GET CHAR(S) INTO IT THEN REENTER GGETC
;TO GET THEM OUT. THIS METHOD SIMPLIFIES CORRECT
;MULTIPLE-SPACING AFTER EOLS IN ALL FUNNY CASES AT END OF PAGE.
CALL GETC
CAIE CHR,200
JRST GGETC
RET ;200 FOR EOF ISN'T PUT IN OUTBUF
;GETC
;GET CHARACTER FROM INPUT FILE,
;PUTTING IT IN OUTBUF, KEEPING TRACK OF CHARACTER POSITION ON PAGE,
;INSERTING EOLS FOR LINE WIDTH OVERFLOW AND MULTIPLE SPACING, ETC.
;CLOBBERS A-D.
GETC: TLNE F,B7+B8+B12+B13
JRST GETC20 ;GO HANDLE SPECIAL CONDITIONS
;GET CHARACTER FROM INPUT BUFFER
ILDB CHR,INPTR
SUBI CNT,1 ;UPDATE COUNT OF CHARS REMAINING
JUMPE CHR,[;NULL ENCOUNTERED. THIS IS END OF BUFFER ONLY IF
;COUNT ALSO USED UP, SO NULLS IN A BAD FILE DON'T
;CAUSE LOSS OF FOLLOWING GOOD DATA IN SAME BUFFER.
;COUNT IS DISREGARDED TIL A NULL TO PERMIT USE IN
;SCANNING DEFAULT HEADING, AN ASCIZ STRING OF UNKNOWN
;LENGTH.
JUMPG CNT,.+1 ;NOT END OF BUFFER, TRANSMIT NULL.
TLNE F,B11 ;DID READING THIS BUFFER HIT EOF?
JRST [ TLO F,B12 ;YES, SAY ALL CHARS NOW USED
JRST GETC] ;REENTER GETC TO RET SPEC CODE.
MOVE INPTR,[POINT 7,INBUF,-1]
HRRZ A,@INIFH1
MOVE B,INPTR
MOVEI CNT,INBUFL
MOVE C,CNT
TLNN F,B15 ;IF NOT TTY:, THEN..
MOVNI C,INBUFL ;USE NEG. SIN COUNT FOR SPEED
MOVEI D,CTRLZ ;END ON ↑Z FOR TTY
SIN ;READ A BUFFERFUL
JRST LSTE1] ;GO COMPUTE COUNT
;GETC4 GETC4A GETC7 GETC8
;LIST/TYPE SUBR GETC...
;FOR TTY SOURCE ↑Z IS EOF
CAIN CHR,CTRLZ
JRST [ TLNN F,B15
JRST .+1
SETZM EOFDSP
TLO F,B12
JRST GETC]
;IF NOT PRINTING, DON'T STORE OR ACCOUNT CHAR POSITION
TLNE F,B4
RET
;ACCOUNT CHARACTER POSITION AND SO ON
GETC4: CAIG CHR,37
JRST GETC10 ;CONTROL CHAR
;ALL OTHER CHARS SPACE ONE
GETC4A: MOVEI CNO,1(CNO)
GETC7: CAMLE CNO,WIDTH
JRST [ ;PAGE WIDTH OVERFLOW
MOVE A,INPTR
BKJFN ;PUT CHAR BACK IN BUFFER
CALL JERR
MOVE INPTR,A
MOVEI CHR,EOL ;RETURN EOL
TLO F,B8 ;SAY IT WAS FORCED EOL
TLZ F,B9 ;SAY NOT CONTROL CHAR TO INDICATE W ↑X
JRST GETC4]
;STORE CHAR IN OUTBUF AND RETURN
GETC8: TLZE F,B9
JRST [ ;INDICATE CONTROL CHARACTER WITH ↑X
MOVEI B,"↑"
IDPB B,OUTPTR
MOVEI B,100(CHR)
IDPB B,OUTPTR
RET]
IDPB CHR,OUTPTR ;STORE CHAR FOR PRINTOUT
RET
;GETC10 GETC11
;LIST/TYPE SUBROUTINE GETC...
;CONTROL CHARACTERS
GETC10: TLNN F,B2 ;INDICATING NULLS,...
JUMPE CHR,GETC ;OR NOT A NULL
CAIN CHR,TAB
JRST [ ADDI CNO,10 ;ASSUME TAB STOPS EVERY 8 COLUMNS
TRZ CNO,7
JRST GETC7]
CAIN CHR,EOL
JRST [ SETZ CNO,
TLO F,B13 ;SAY TO OUPUT AN LF NEXT CALL
MOVEI CHR,CR ;BUT DO A RETURN THIS TIME
JRST GETC8]
CAIN CHR,LF
GETC11: JRST [ MOVEI LNO,1(LNO)
SKIPE SPCG ;IF SPACING >1,
TLO F,B7 ;SAY DO MULTIPLE-SPACING ON NEXT CALL
JRST GETC8]
CAIN CHR,CR
JRST [ SETZ CNO,
JRST GETC8]
CAIN CHR,FORMF
JRST GETC8 ;FORMFEED ISN'T ACCOUNTED AT GETC LEVEL
;REMAINING CONTROLS ARE EITHER INDICATED (↑X, 2 COLS) OR SENT (1 COL)
TRNE F,1B18 ;"VERBATIM"
JRST [ CAIN CHR,10 ;BACKSPACE?
SOJGE CNO,GETC7;YES COUNT AS -1 UNLESS AT LEFT MARGIN
AOJA CNO,GETC7] ;NO, COUNT AS +1
TLO F,B9 ;REMEMBER THIS SPECIAL CASE
MOVEI CNO,2(CNO) ;↑X TAKES 2 COLUMNS
JRST GETC7
;GETC20 LSTEOF LSTE1
;LIST/TYPE SUBROUTINE GETC...
;SPECIAL FLAG(S) ON AT (RE)ENTRY
GETC20: TLNE F,B12
JRST [ MOVEI CHR,200 ;AT EOF, RETURN SPECIAL CODE 200
JRST GETC8] ;PUT NULL IN OUTBUF
TLZE F,B13 ;LAST CALL OUTPUT CR IN PLACE OF EOL
JRST [ MOVEI CHR,LF ;STUFF OUT LF THIS TIME
JRST GETC11]
TLNE F,B4
JRST [ TLZ F,B7+B8 ;NOT PRINTING, DONT PROCESS THESE
JRST GETC] ;SPECIAL CASES
TLZE F,B8
JRST [ ;ON CALL AFTER LINE WIDTH OVERFLOW FORCED EOL, STORE **
;NOTE THAT FORCED EOLS ALWAYS SINGLE-SPACE
TLZ F,B7
MOVE C,WIDTH ;SPACE HALFWAY ACROSS LINE TO CONTINUE
ASH C,-1
ADD CNO,C
MOVEI B," "
JSP D,[JRST 0(D)] ;REMEMBER 'POINT'
IDPB B,OUTPTR
SOJG C,0(D) ; .-1 ACTUALLY...
MOVEI B,"*"
IDPB B,OUTPTR
IDPB B,OUTPTR
MOVEI CNO,2(CNO)
CAML CNO,WIDTH ;FOR SAFETY: OTHERWISE IF WIDTH IS 0
CALL SCREWUP ;EXEC IS WIPED OUT BY HEADING
JRST GETC] ;REENTER GETC TO GET CHARACTER
TLZN F,B7
CALL SCREWUP
;ON CALL AFTER EOL OR LF, STORE EXTRA CRLF + LF'S FOR MULT SPACING
MOVE D,SPCG
ADD LNO,D
MOVEI B,CR
IDPB B,OUTPTR
MOVEI B,LF
IDPB B,OUTPTR
SOJG D,.-1
JRST GETC ;REENTER GETC TO GET CHARACTER
;LIST/TYPE EOF PSI ROUTINE. CAN ONLY BE ENTERED DURING CALL TO GETC.
LSTEOF: SETZM EOFDSP ;JUST TO BE SURE
TLO F,B11 ;SAY EOF ENCOUNTERED
LSTE1: MOVMS C
SUB CNT,C ;COMPUTE NUMBER CHARS READ
SETZ C,
IDPB C,B ;TERMINATE WITH NULL!
JRST GETC ;GET CHAR FROM BUFFERFUL JUST READ, AND
;CONTINUE NORMALLY TILL BUFFER USED.
;COMCHR COMCH1 COMCH2 COMCHX STRCOM STRCO1 STRCO2 EXTTAB
;LIST/TYPE ...
;OUTPUT THE COMMENT CHARACTER INTO THE HEADING STRING
;CHARCRER (STRING) IS DETERMAMINED FROM FILE EXTENSION
;1: OUTPUT STRING POINTER
; CALL COMCHR
;R+1: ALWAYS, 1 UPDATED
COMCHR: PUSH P,1
PUSH P,2
PUSH P,3
SETOM (1) ;IN CASE NO EXTENSION
HRRZ 2,@INIFH1 ;CURRENT JFN
MOVSI 3,(1B11) ;EXT ONLY
JFNS
COMCH1: MOVSI 3,-EXTL
COMCH2: MOVSI 2,(POINT 7,)
HLR 2,EXTTAB(3)
MOVE 1,-2(P) ;WHERE EXT WRITTEN
CALL STRCOM ;COMPARE STRINGS
JRST [ AOBJN 3,COMCH2 ;NOT EQUAL, TRY NEXT
MOVEI 2,";" ;USE ; IF NOTHING ELSE
MOVE 1,-2(P)
BOUT
JRST COMCHX]
HRRO 2,EXTTAB(3)
SETZ 3,
MOVE 1,-2(P)
SOUT
COMCHX: POP P,3
POP P,2
SUB P,[1,,1]
RET
;STRING COMPARE
;1: STRING POINTER
;2: STRING POINTER
; CALL STRCOM
;R+1: NOT EQUAL
;R+2: EQUAL
STRCOM: PUSH P,1
PUSH P,2
STRCO1: ILDB 1,-1(P)
ILDB 2,0(P)
CAIE 1,0(2)
JRST STRCO2
JUMPN 1,STRCO1
AOS -2(P)
STRCO2: POP P,2
POP P,1
RET
DEFINE ETAB(TRANS,COMMNT)<[ASCIZ \TRANS\],,[ASCIZ \COMMNT\]>
EXTTAB: ETAB (MAC,<;>)
ETAB (MID,<;>) ; FOO, BBN, MIDAS DOESN'T USE SLASH!
ETAB (FAI,<;>)
ETAB (PAL,</>)
ETAB (BCP,<//>)
ETAB (F4,<C>)
ETAB (F40,<C>)
ETAB (FOR,<C>)
ETAB (F10,<C>)
ETAB (P11,<;>)
ETAB (BLI,<!>)
ETAB (PPL,<... >) ;(HOMNEST!)
EXTL==.-EXTTAB
;SITEO SITEX LITC4A
;LIST/TYPE ...
;SUBROUTINE TO OUTPUT SITE ON DESIGNATOR IN A
;RETURNS A UPDATED IF STRING POINTER
SITEO: PUSH P,B
PUSH P,C
PUSH P,A
MOVE A,['LHOSTN']
CALL $SYSGT
JUMPE B,SITEX
MOVEI A,0(B) ;FORM 0,,TABLE
GETAB
JRST SITEX
EXCH A,0(P) ;GET BACK OUTPUT PTR, SAVE SITE #
MOVEI B,"["
BOUT
POP P,B ;SITE #
MOVEI C,↑D10 ;FOR NOUT
CVHST ;HOST TO STRING CONVERSION
NOUT ;FAILING THAT, A NUMBER
JFCL
MOVEI B,"]"
BOUT
CAIA
SITEX: POP P,A
POP P,C
POP P,B
RET
LITC4A: XLIST
LIT
LIST
;.DETAC .REDIR RED2
;"REDIRECT" AND "DETACH" COMMANDS
;REDIRECT (INFILE) <NAME>/* (OUTFILE) <NAME>/* (AND) START/REENTER/CONT
;DETACH IS SAME SYNTAX AND HAS SAME MEANING EXCEPT IT DETACHES
; TERMINAL AFTER REDIRECTING IO.
;ALL ARGUMENTS CAN BE OMITTED AND DEFAULT TO NULL
.DETAC: TLO Z,DTACHF ;SET "DETACH" FLAG
.REDIR: ;"REDIRECT": FLAG IS ALREADY CLEAR.
;DECODE ARGUMENTS
;GET INPUT FILE NAME, OR "*" FOR OLD, OR NULL OR "-" FOR NO CHANGE
NOISE <infile>
MOVE A,[1,,[ASCIZ /INP/]] ;"ALLOW *" FLAG, DEFAULT EXT
CALL CINFN ;INPUT A FILE NAME, *, -, OR NULL
JRST [ PUSH P,A ;NOT A FILE NAME (* OR -)
MOVE A,[1,,1];STEP JFN BUFFER PTR PAST CJFN1,
ADDM A,JBUFP ;SO COUTFN WON'T CLOBBER IT.
POP P,A
CAIE A,"*" ;HOW CINFN INDICATES "*"
JRST [ SETOM CJFN1 ;SAY NO INPUT REDIRECTION FILE
JRST RED2] ;NULL OR "-"
SKIPG CREDIF ;*. IS THERE A PREVIOUS FILE?
UERR [ASCIZ /No previous input file/]
MOVE A,CRJFNI ;OLD INPUT JFN FROM BEFORE ↑C
GTSTS ;GET JFN'S CURRENT STATUS
TLNN B,200 ;JFN STILL VALID? (USER CD HAVE FLUSHED)
JRST [ SETZM CREDIF ;INVALID, FORGET IT
UERR [ASCIZ /Old input file has been closed & released/]]
TLNE B,B0 ;OPEN?
TLNN B,B1 ;FOR INPUT?
JRST [ ;JFN IS ASSOCIATED WITH A FILE, BUT FILE
;ISN'T OPEN FOR INPUT.
;IDEALLY WE SHOULD HAVE SAVED THE OLD
;FILE POINTER TO RESTORE AND CONTINUE.
;(AND ALSO I GUESS THE FILE'S NAME TO BE
;SURE USER HASN'T OPENED ANOTHER FILE
;WITH SAME JFN.) FOR NOW, ERROR.
UERR [ASCIZ /Old input file has been closed/]]
JRST .+1] ;ITS OK.
MOVEM A,CJFN1 ;JFN FROM CINFN OR CRJFNI
SKIPGE CREDIF
ERROR <Input already redirected>
RED2: ALLOW TALT+TSPC+TEOL+TLPR
;RED3 RED4
;DECODING OF REDIRECT/DETACH...
;OUTFILE SIMILALARLY
NOISE <outfile>
MOVE A,[1,,[ASCIZ /OUT/]]
CALL COUTFN
JRST [ CAIE A,"*"
JRST [ SETOM CJFN2
JRST RED4]
SKIPG CREDOF
UERR [ASCIZ /No previous output file/]
MOVE A,CRJFNO
GTSTS ;CHECK ITS VALIDITY
TLNN B,200
JRST [ SETZM CREDOF ;BAD JFN, FORGET ABOUT IT
UERR [ASCIZ /Old output file has been closed & released/]]
TLNE B,B0 ;OPEN?
TLNN B,B2 ;FOR WRITE?
JRST [ UERR [ASCIZ /old output file has been closed/]]
JRST RED3]
TLO KWV1,CONMAN ;IF FILE NAME WAS GIVEN, CONF. MANDATORY
TRNE CBT,TSPC ;IF FILE NAME WAS TERMINATED WITH SPACE,
PRINT " " ;TYPE SPACE AFTER "[OLD/NEW FILE]"
RED3: MOVEM A,CJFN2
SKIPGE CREDOF
ERROR <Output already redirected>
RED4: ALLOW TALT+TSPC+TEOL+TLPR
;START/REENTER/CONTINUE ARGUMENT
NOISE <and>
KEYWD $REDIR
T -,EOLOK,<[..DTCH,,[RET]]> ;DEFAULT TO NOTHING
ERROR <START, REENTER, CONTINUE, or nothing>
;KWV POINTS TO A WD WHOSE RH POINTS TO A SUBR TO FINISH DECODING
; AND CHECK THE ARGUMENT.
MOVE A,(KWV)
CALL (A) ;CALL ARGUMENT-DEPENDENT DECODE & CHECK SUBR
CONFIRM
;REDIRECT/DETACH...
;EXECUTE REDIRECT/DETACH COMMANDS
;NOW HAVE JFN'S IN CJFN1 & 2, PTR TO START/REE/CON/NOTHING IN KWV.
;EXECUTION BEGINS WITH REDIRECTING THE I/O.
;IT APPEARS THAT WE MUST FLUSH OLD SAVED PRIMARY FILES BEFORE
; REDIRECTING TO THE NEW ONES IN ORDER TO AVOID A HORRENDOUSLY
; COMPLICATED PROBLEM OF KEEPING TRACK OF EVERYTHING AND MAKING
; THE RIGHT THING HAPPEN ON ERRORS AND ↑C'S WHICH OCCUR
; DURING THE REDIRECTION PROCESS.
;THIS MEANS THAT IF COMMAND DOESN'T COMPLETE SUCCESSFULLY THE
; OLD FILES MAY NEVERTHELESS BE CLOSED.
TLNE Z,DTACHF
ETYPE < Detaching job # %J
>
;REDI0 REDI1 REDI2 REDI3 REDI4
;EXECUTION OF REDIRECT/DETACH...
;REDIRECT INPUT
; CLOSE OLD FILE
REDI0: MOVE A,CRJFNI
MOVE B,CREDIF
CAIN B,1 ;IS THERE AN OLD ONE?
CAMN A,CJFN1 ;YES, IS IT DIFFERENT FROM NEW?
JRST REDI2 ;NO OR NO: NO OLD ONE, OR "*" GIVEN.
GTSTS ;GET CURRENT STATUS OF THIS OLD JFN
TLNN B,200
JRST REDI1 ;NO GOOD, FORGET IT.
TLNN B,B0
JRST [ RLJFN ;GOOD BUT NOT OPEN, JUST RELEASE IT
CALL JERR
JRST REDI1]
CLOSF ;CLOSE OLD ONE & RELEASE JFN
CALL JERR
REDI1: SETZM CREDIF ;SAY THERE'S NO LONGER AN OLD ONE
; OPEN NEW INPUT FILE IF NOT OPEN
; (NOTE THAT IF * GIVEN IT WILL TYPICALLY BE OPEN)
REDI2: MOVE A,CJFN1 ;JFN OF NEW PRI INPUT FILE
JUMPL A,REDI4 ;-1 MEANS NONE SPECIFIED
GTSTS ;GET ITS STATUS
TLNN B,200
CALL SCREWUP ;BUG IF BAD JFN GETS THIS FAR.
TLNE B,B1
JRST REDI3 ;ALREADY OPEN FOR READ
MOVE B,[7B5+0B9+1B19] ;7 BIT ASCII READ
OPENF
CALL JERR
REDI3: INTOFF ;BE SURE CREDIF AND SPJFN AGREE
GPJFN
HRL 2,CJFN1 ;NEW INPUT JFN
SPJFN
SETOM CREDIF ;INDICATE INPUT NOW REDIRECTED
INTON
REDI4:
;REDO0 REDO1 REDO2 REDO3 REDO4
;REDIRECT/DETACH...
;EXECUTION...
;REDIRECT OUTPUT
; CLOSE OLD FILE IF THERE IS ONE AND IT'S NOT TO BE REUSED
REDO0: MOVE A,CRJFNO
MOVE B,CREDOF
CAIN B,1
CAMN A,CJFN2
JRST REDO2
GTSTS ;MAKE SURE ITS GOOD AND OPEN BEFORE CLOSING
TLNN B,200
JRST REDO1 ;BAD, FORGET IT
TLNN B,B0
JRST [ RLJFN ;GOOD BUT CLOSED, JUST RELEASE
CALL JERR
JRST REDO1]
CLOSF ;GOOD AND OPEN, CLOSE AND RELEASE.
CALL JERR
REDO1: SETZM CREDOF
; OPEN NEW FILE, IF ANY
REDO2: MOVE A,CJFN2
JUMPL A,REDO4 ;NO NEW FILE
GTSTS
TLNN B,200
CALL SCREWUP ;BAD JFN SHOULDN'T GET THIS FAR
TLNE B,B2 ;OPEN FOR OUTPUT?
JRST REDO3 ;ALREADY OPEN FOR WRITING.
MOVE B,[7B5+0B9+1B20] ;7 BIT ASCII WRITE
OPENF
CALL JERR
REDO3: INTOFF
GPJFN
HRR 2,CJFN2 ;NEW OUTPUT JFN
SPJFN
SETOM CREDOF
INTON
REDO4: MOVEI E,ETTYMD ;TTY MODES FOR USE WHEN EXEC IS RUNNING
CALL LTTYMD ;PUT SAME INTO EFFECT NOW.
;$REDIR ..DTCH
;REDIRECT/DETACH...
;EXECUTION...
;I/O ALL REDIRECTED, NOW START/REENTER/CONTINUE.
;KWV POINTS TO WD WHOSE LH POINTS TO ROUTINE TO START THE FORK (OR NOT),
; DETACH TERMINAL IF "DTACHF" ON, WAIT FOR TERMINATION.
HLRZ A,(KWV)
JRST (A) ;DISPATCH TO
;FINAL-ARGUMENT-DEPENDENT EXECUTION ROUTINE
;TABLE FOR THIRD ARGUMENT
;VALUE POINTS TO A WORD --
; RH: DECODE-AND-CHECK SUBR ADDRESS
; LH: EXECUTION DISPATCH ADDRESS
$REDIR: TABLE
T CONTINUE,EOLOK,<[..CONT,,$CONTI]>
T REENTER,EOLOK,<[..REEN,,$REENT]>
T START,EOLOK,<[..STRT,,$START]>
TEND
;EXECUTION ROUTINE FOR NULL THIRD ARGUMENT
..DTCH: TLNE Z,DTACHF
DTACH
JRST CMDIN4
;..CONT, ..REEN, ..STRT ARE WITH THE CORRESPONDING COMMANDS.
SUBTTL PDP-10 TENEX EXECUTIVE ** X3CMD.MAC **
;ROUTINES TO DECODE AND EXECUTE SPECIFIC COMMANDS.
;THIS FILE CONTAINS LONG AND NOT PARTICULARLY COMMON
;COMMANDS, SEGREGATED FROM THE OTHER, SHORTER, COMMAND
;ROUTINES TO REDUCE THE EXEC'S NORMAL WORKING PAGE SET.
;CONTENTS
; ARCHIVE
; QFD
; DIRECTORY
; QD, QW, QR
;DEFINITIONS REQUIRED FOR DIRECTORY LISTER
DIRORG=760000 ;BASE OF 8-PAGE AREA WHERE DIRECTORY IS MAPPED
;DIRECTORY FIXED ALLOCATION AREA
;DIRLCK==DIRORG+0
;DIRUSE==DIRORG+1
DIRNUM==DIRORG+2 ;DIRECTORY NUMBER
SYMBOT==DIRORG+3 ;BEGINNING OF SYMBOL TABLE
SYMTOP==DIRORG+4 ;END OF SYMBOL TABLE
;FILE DESCRIPTOR BLOCK
FDBCTL==1 ;CONTROL BITS IN LH THIS WORD
FDBNEX==B2 ;SET IF FILE HAS NO EXTENSION & DOESN'T EXIST
FDBNXF==B4 ;FILE DOESN'T EXIST BECAUSE 1ST WRITE NOT DONE
FDBEXT==2 ;LOC EXT BLOCK,, FDB FOR NEXT EXTENSION
FDBPRT==4 ;PROTECTION
FDBUSE==6 ;WRITER,, USE COUNT
FDBVER==7 ;VERSION #,, LOC FDB FOR NEXT VERSION
FDBACT==10 ;ACCOUNT # (NEG) OR STRING BLOCK PTR (POS)
FDBSIZ==12 ;SIZE IN BYTES (COUNT THAT WOULD ADDRESS EOF)
FDBCRV==13 ;VERSION CREATION DATE AND TIME
FDBWRT==14 ;WRITE DATE AND TIME
FDBRED==15 ;REFERENCE DATE AND TIME
FDBBCK==17 ;BACKUP (ARCHIVAL) WORD
;LH = BITS, RH = MOST RECENT TAPE #
FDBARC==200000 ;ARCHIVE REQUEST
FDBNAR==100000 ;DON'T (EVER) ARCHIVE REQUEST
AFDBDL==10000 ;DON'T DELETE AFTER ARCHIVING
FDBAAR==4000 ;FILE IS ALREADY ARCHIVED
;.ARCHI $ARCHI ARC.FL ARCH3 ARCH1 ARCH2
;ARCHIVE COMMAND
;USE OF F REG:
; SINCE ONLY THE LEFT 18 BITS OF FDBBCK CAN BE CHANGED
; (AND SINCE THE LEFT-MOST BIT IS NOT USED BY BSYS)
; F IS DIVIDED INTO 2 PARTS, GIVING ALL INFO FOR CHFDB
; LH - NEW VALUES FOR THE BITS IN LH OF FDBBCK
; (BIT 0 IS USED AS A HACK FOR THE STATUS COMMAND)
; RH - WHICH BITS TO CHANGE IN LH OF FDBBCK
; LH AND RH USED BASICALLY AS IN GTFDB AFTER FULL
; REGISTER EXTENSION
REPEAT 0,<
.ARCHI: KEYWD $ARCHI
0 ;NO DEFAULT KEYWORD
JRST CERR
JRST (KWV)
$ARCHI: TABLE
T DELETE,LPROK+LANOK,ARC.DL
T EXPUNGE,LPROK+LANOK,ARC.EX
T FILE,COMOK+LPROK+LANOK,ARC.FL
T RESET,LPROK+LANOK,ARC.RS
T STATUS,LPROK+LANOK,ARC.ST
T UNDELETE,LPROK+LANOK,ARC.UN
TEND
ARC.FL: NOISE <file list>
MOVE A,[2,,2] ;DEFAULT NAME AND EXT
MOVE B,[-2,,B2+B11+B15+B16] ;DEFAULT TO LOWEST VERSION
CALL $INFG ;GTJFN W/B FLAGS
;IF SUBCOMMANDS START WITH DEFAULTS AND LET USER ALTER THEM
JRST [ MOVE F,[FDBARC,,FDBARC+AFDBDL+FDBNAR]
CONFIRM ;, TYPED
SUBCOM $ARC
JUMPE F,ARCH3 ;NO SUBCOMMANDS AFTER ,
JUMPGE F,ARCH1 ;STATUS SUBCOMMAND CAN'T BE MIXED
TRNE F,377777
JRST STATER
JRST ARCH1]
CONFIRM
;DEFAULT - ARCHIVE AND DELETE, RESET "DON'T DELETE"
ARCH3: MOVE F,[FDBARC,,FDBARC+AFDBDL+FDBNAR]
ARCH1: HRRZ A,@INIFH1 ;JFN
DVCHR
TLNN B,B4 ;DSK (MULT DIR) CHECK
ERROR <Cannot archive non-disk files>
HRRZ A,@INIFH1 ;GET CONTROL WORD BITS INTO C
MOVE B,[1,,FDBCTL]
MOVEI C,C
CALL $GTFDB
SETO C, ;$GTFDB ERROR
TLNE C,(FDBDEL) ;ERROR IF DELETED UNLESS DOING GROUP
JRST [ TLNN Z,GROUPF
UERR [ASCIZ /Cannot manipulate deleted file/]
JRST ARCH2]
MOVE B,[1,,FDBBCK] ;GET BACKUP BITS
MOVEI C,C
CALL $GTFDB
SETO C, ;$GTFDB ERROR
JUMPL F,ARCSTR ;SO STATUS IF STATUS
TLNE C,FDBAAR ;IF ARCHIVED, OK IF DOING GROUP
JRST [ TLNN Z,GROUPF
UETYPE [ASCIZ /File %1S already archived/]
JRST ARCH2]
CALL TYPIF ;TYPE FILENAME IF GROUP DESIG.
HRLI A,FDBBCK ;A - DISP,JFN
HRLZI B,0(F) ;B - BITS TO CHANGE
HLLZ C,F ;C - VALUES TO CHANGE TO
CHFDB
ARCH2: CALL GNFIL ;GET NEXT FILE
JRST RLJFNS ;NO MORE - RELEASE AND EXIT
JRST ARCH1 ;MORE
>
;ARC.DL ARC.UN ARC.EX ARC.RS ARC.ST
REPEAT 0,<
; "ARCHIVE DELETE ..."
ARC.DL: ALLOW TSPC+TALT
HRROI B,[ASCIZ /<SYSTEM>ARCHIVE-LOOKUP.SAV/]
CALL TRYGTJ
ERROR <No lookup program???>
TLO KWV1,PROGX
MOVEI B,4 ;ENTRY VECTOR INDEX FOR DELETE
JRST CIN40 ;RUN IT AS AN EPHEMERON
; "ARCHIVE UNDELETE ..."
ARC.UN: ALLOW TSPC+TALT
HRROI B,[ASCIZ /<SYSTEM>ARCHIVE-LOOKUP.SAV/]
CALL TRYGTJ
ERROR <No lookup program???>
TLO KWV1,PROGX
MOVEI B,6 ;ENTRY VECTOR INDEX FOR UNDELETE
JRST CIN40 ;RUN IT AS AN EPEMERON
; "ARCHIVE EXPUNGE ..."
ARC.EX: JRST NIYE
; "ARCHIVE RESET ..."
ARC.RS: NOISE <files>
MOVE A,[2,,2]
MOVEI B,B2+B8+B11+B15+B16 ;GTJFN FLAGS
CALL $INFG ;INPUT FILE GROUP
JRST CERR
CONFIRM
HRRZI F,FDBARC+FDBNAR+AFDBDL
JRST ARCH1 ;GO DO IT
; "ARCHIVE STATUS ..."
ARC.ST: NOISE <of files>
MOVE A,[[ASCIZ /*/],,[ASCIZ /*/]] ;DEFAULT NAME AND EXT
MOVE B,[-3,,B2+B8+B11+B15+B16] ;* VERSION, IGNORE DELETED
CALL SPECFN
JRST CERR
CONFIRM
MOVSI F,(1B0)
JRST ARCH1
>
;ARCSTR $ARC ..ARDF ..ARDL
REPEAT 0,<
ARCSTR: TLNE Z,GROUPF ;IF DOING A GROUP, TYPE NAME
ETYPE <%1S :>
MOVE B,[2,,FDBBCK] ;GET REAL STATUS VIA GTFDB
MOVEI C,C ;C←BITS,,LAST DUMP #; D←1ST AREC #,,2ND ARC #
CALL $GTFDB
ERROR <$GTFDB error>
HRRZ G,C ;G←LAST DUMP TAPE #
HRRZ E,D ;E←2ND ARC TAPE #
HLRZ D,D ;D←1ST ARC TAPE #
TLNE C,FDBARC
JRST [ UTYPE [ASCIZ / Archive /]
TLNE C,AFDBDL
UTYPE [ASCIZ /without /]
TLNN C,AFDBDL
UTYPE [ASCIZ /and /]
UTYPE [ASCIZ /deletion pending;/]
JRST .+1]
TLNE C,FDBNAR
UTYPE [ASCIZ / Archive not allowed;/]
TLNE C,FDBAAR
ETYPE <
Archived - Dump tape # %7Q, 1st archive tape # %4Q, 2nd archive tape # %5Q>
TLNN C,377777 ;SAY NOTHING IF NOTHING
UTYPE [ASCIZ /None;/]
PRINT EOL
JRST ARCH2
$ARC: TABLE
T DEFERRED,ONEWD,..ARDF
T DELETE,ONEWD,..ARDL
T DON'T,,..ARDN
T IMMEDIATE,ONEWD,..ARCIMMED
TEND
..ARDF: ;DEFERRED DEFAULTS TO AND DELETE, FALL INTO IT
;SET ARCHIVE, RESET DON'T DELETE AND DON'T ARCHIVE
..ARDL: JUMPL F,STATER ;CAN'T MIX STAT
MOVE F,[FDBARC,,FDBARC+FDBNAR+AFDBDL]
RET
>
;..ARDN $DONT ...DAR ...DDL STATER
REPEAT 0,<
..ARDN: JUMPL F,STATER ;CAN'T MIX STAT
KEYWD $DONT
0 ;NO DEFAULT
JRST CERR ;NULL ILLEGAL
CONFIRM
JRST (KWV)
$DONT: TABLE
T ARCHIVE,ONEWD,...DAR ;DON'T ARCHIVE
T DELETE,ONEWD,...DDL ;DON'T DELETE (IF ARCHIVED)
TEND
;RESET ARCHIVE, SET DON'T ARCHIVE
...DAR: JUMPL F,STATER ;CAN'T MIX STAT
TLO F,FDBNAR ;GOING TO SET DON'T ARCHIVE
TLZ F,FDBARC ;GOING TO RESET ARCHIVE REQUEST
TRO F,FDBARC+FDBNAR ;YUP
RET
;DON'T DELETE MEANS SET ARCHIVE AND DON'T DEL, RESET DON'T ARCH.
...DDL: TRO F,AFDBDL ;DON'T DELETE AFTER ARCHIVING
TLO F,AFDBDL
RET
..ARCIMMED: JUMPL F,STATER ;CAN'T MIX STAT
;WOULD MARK ARCHIVED BIT HERE ?? (UGH - NOT YET ON TAPE)
JRST NIYE ;IMMEDIATE NOT IMPLEMENTED YET
>
STATER: ERROR <Status subcommand cannot be mixed with other subcommands>
;.QFD .QD .QW .QR
;QFD
;QUICK FILE DESCRIPTION
;INTENDED TYPICAL USE IS "QFD <FILE NAME>" WHICH GIVES AN "EVERYTHING"
; DIRECTORY PRINTOUT FOR THE SINGLE FILE, WITHOUT EXCESS SPACES OR HEADG
;BUT IMPLEMENTATION IS LIKE "DIR" PLUS SUBCOMMANDS
; CRAM, EVERYTHING, AND NO (HEADING);
; THUS ADDITIONAL SUBCOMMANDS AND DIFFERENT ARGUMENTS (INCLUDING NONE)
; ARE POSSIBLE.
.QFD: MOVE E,[001110,,065241]
HRLZI F,B10 ;SAY QFD MODE - ONLY DIR PART OF HEADING PRINTS
JRST DIR0
.QD: MOVE E,[001110,,065241]
HRLZI F,B10+B17
JRST DIR0 ; THESE ARE HPPS GOODIES
.QW: MOVE E,[001110,,065301]
HRLZI F,B10
HRRI Z,1B31+1B35
JRST DIR0
.QR: MOVE E,[001110,,065301]
HRLZI F,B10
HRRI Z,1B32+1B35
JRST DIR0
;.DIREC DIR0
;DIRECTORY.
;CAN TAKE AN ARGUMENT SPECIFYING DIRECTORY OR FILES TO LIST.
;CAN BE TERMINATED WITH COMMA TO INITIATE SUBCOMMAND INPUT.
;AC USE
; E FIELDS-TO-PRINT INFO A LA JFNS JSYS CALL.
; ALSO: B26: PRINT LENGTH IN BYTES
; B27: CREATE TIME (IMPLIES CREATE DATE)
; B28: WRITE TIME (IMPLIES WRITE DATE)
; B29: READ DATE (IMPLIES READ TIME)
; B30: PRINT AUTHOR (WRITER)
; B32: SUPPRESS COLUMNATION (CRAM)
; F FLAGS FOR FORMAT, ETC:
; B10 QFD, ONLY DIR PART OF HEADING PRINTS
; B11 USE 10/50 FORMAT FOR DECTAPE DIRS
; B12 NOW PRINTING A DECTAPE, NOT DISK
; B13 SUPPRESS HEADING
; B14 SUPPRESS MULTIPLE VERSIONS ON SAME LINE
; B15 SUPPRESS OMISSION OF NAME, EXT WHEN SAME AS ABOVE
; (NOTHING SETS B15 (5/20/70/)).
; B16 DOUBLE SPACE
; B17 DELETED FILES ONLY
; RH Z: FLAGS FOR ORDER OF PRINTOUT:
; B31=20 CHRONOLOGICAL BY WRITE DATE
; B32=10 CHRON READ
; B33=4 CHRON CREATION
; B34=2 ALPHABETIC
; B35=1 INVERSE ALPHABETIC OR CHRONOLOGICAL
; LH Z:
; F1: ON IF LIST ACCESS VIOLATION(S)
; F2: ON IF MORE FILES TO LIST FOR THIS IFH
; F3: ON IF MORE THAN ONE ARGUMENT IN LIST
.DIREC: MOVE E,[001110040001] ;DEFAULT FORMAT: NAME.EXT;VERS;T
SETZ F, ;DEFAULT: NO SPECIAL FORMAT
;"QFD" JOINS HERE
DIR0: MOVE A,['E DIR ']
SETNM
MOVE A,COJFN ;DEFAULT OUTPUT TO PRI FILE
MOVEM A,OUTDSG ;NB: RH OF Z IS 0
;DECODE ARGUMENT LIST WITH SUBROUTINE "DIRARG" IN SUBRS.MAC.
;THIS INPUTS A FILE GROUP (NAMES WITH "*" ALLOWED,
;MULTIPLE NAMES ALLOWED, -2 RETURNED FOR EACH EMPTY DIR).
;DEFAULTS NOTHING TO WHOLE CONNECTED DIRECTORY;
;INTERPRETS COMMA OR EOL TERMINATOR TO THE
;WORD "DIRECTORY".
CALL DIRARG
JRST [ CONFIRM ;R1: LIST ENDED WITH COMMA
SUBCOM $DIR ;INPUT SUBCOMMANDS FROM TABLE $DIR
JRST .+2]
CONFIRM
;DIRFL DDIR
;EXECUTE "DIRECTORY"
MOVE A,OUTDSG ;OUTJFN
MOVEI B,1B20 ;WRITE.
CALL $OPEN7 ;OPEN, 7 BIT BYTES, MODE 0.
MOVE A,INIFH1 ;PTR TO FIRST JFN IN BUFFER
CAMGE A,INIFH2 ;PTR TO LAST
TLO Z,F3 ;SET FLAG IF MORE THAN 1 JFN
SETOM OLDDIR ;IMPOSSIBLE DIRECTORY NUMBER
;COME BACK HERE TO PROCESS NEXT ARGUMENT IN LIST
DIRFL: CALL UNMDIR ;UNMAP DIR'TORY BUF PAGES, THUS 0ING THEM
TLZ Z,F2
MOVE A,OUTDSG
HRROI B,[ASCIZ /
/]
SETZ C,
TRNN E,1B32 ;SKIP INITIAL CR IN CRAM FORMAT FOR QFD
SOUT ;BLANK LINE ABOVE DIRECTORY
HRRZ A,@INIFH1 ;JFN
CAIN A,-2 ;TREAT EMPTY DIR AS DISK
JRST DDIR
DVCHR
LDB B,[POINT 9,B,17] ;DEVICE TYPE
JUMPE B,DDIR ;DISK
CAIE B,3 ;DECTAPE
ERROR <Illegal device>
TLOA F,B12 ;DECTAPE. DEV DESIGNATOR IN A.
;DISK
;E,F, AND Z STILL CONTAIN VARIOUS FLAGS (SEE ABOVE)
DDIR: TLZ F,B12
CALL DNAME ;TYPE DIRECTORY NAME IF APPROPRIATE
CALL DSKDIR ;LIST IT
;DONE A DEVICE OR DIRECTORY.
;F2 SET IF MORE FILES FOR THIS JFN.
TLNE Z,F2
JRST DIRFL ;DO NEXT ONE FOR THIS JFN (NOW GNJFN'D)
;NEXT ARGUMENT IN LIST
AOS A,INIFH1 ;STEP POINTER INTO JFN BUFFER
CAMG A,INIFH2 ;BEYOND END?
JRST DIRFL ;NO
CALL UNMDIR ;UNMAP BUFFERS
MOVE A,OUTDSG
MOVEI B,CR
BOUT ;BLANK LINE AFTER ALL
MOVEI B,LF
BOUT
CALL RLJFNS ;RELEASE JFNS
JRST CMDIN4 ;GO GET NEXT COMMAND
;UNMDIR
;UNMDIR
;SUBROUTINE TO UNMAP PAGES USED AS BUFFERS IN LISTING DIRECTORIES
;CLOBBERS A-D. ALSO USED IN LIST/TYPE.
UNMDIR: SETO A,
MOVE B,[B0,,<BUF1>B44]
HRLZI C,1
MOVEI D,767-<BUF1>B44
PMAP
AOS B
SOJGE D,.-2
RET
;$DIR
;DIRECTORY...
;SUBCOMMAND TABLE
$DIR: TABLE
;; T ACCOUNT,ONEWD,...ACC
T ALPHABETIC,ONEWD
T AUTHOR,ONEWD
T BEGIN,ONEWD,0
T CHRONOLOGICAL,EOLOK+LPROK
T CRAM,ONEWD
T DATES,EOLOK+LPROK
T DELETED,EOLOK+LPROK,..DELE
T DOUBLESPACE,ONEWD
T EVERYTHING,ONEWD
T LENGTH,EOLOK+LPROK
T LPT,EOLOK
T NO,EOLOK+LPROK,..NO
T OUTPUT,CONMAN+LPROK
T PROTECTION,ONEWD,..PROT
T REVERSE,ONEWD
T SEPARATE,EOLOK+LPROK
T SIZE,ONEWD,..SIZE
T START,ONEWD+INVIS,0
T TEN50,ONEWD+INVIS,..TEN5
T TIMES,EOLOK+LPROK
T VERBOSE,ONEWD
TEND
;.ALPHA .AUTHO .CHRON $CHRON
;SUB-COMMAND ROUTINES FOR "DIRECTORY" COMMAND
;; ...ACC: TRO E,1B20
;; RET
.ALPHA: TRZ Z,36 ;CLEAR ORDER OF PRINTOUT FLAGS
TRO Z,1B34 ;SAY ALPHABETIC
RET
.AUTHO: CONFIRM
TRO E,1B30
RET
.CHRON: NOISE <by>
KEYWD $CHRON
T WRITE,EOLOK+LPROK,20 ;NULL DEFAULTS TO THIS
JRST CERR ;NOT FOUND IN TABLE
CONFIRM
TRZ Z,36 ;CLR FLAGS RELATED TO ORDER OF PRINTOUT
ORI Z,(KWV) ;AND OR IN THOSE FROM RESPONSE DECODING
RET
$CHRON: TABLE
T CREATION,EOLOK+LPROK,4
T READ,EOLOK+LPROK,10
T WRITE,EOLOK+LPROK,20
TEND
;.CRAM .DATES DATES1 .TIMES $DATE ..DELE .DOUBL .EVERY .LENGT
;DIRECTORY SUB-COMMANDS...
.CRAM: TRO E,1B32
RET
.DATES: NOISE <of>
TLZ Z,F1
DATES1: KEYWD $DATE ;"TIMES" JOINS HERE
T WRITE,EOLOK,1B24
JRST CERR
CONFIRM
MOVEI KWV,(KWV)
TLNE Z,F1
LSH KWV,-4 ;TIME ARE 4 BITS TO LEFT OF DATE BITS
IORI E,(KWV) ;UPDATES JFNS OPTIONS FROM TABLE
RET
.TIMES: NOISE <and dates of>
TLO Z,F1
JRST DATES1
$DATE: TABLE
T CREATION,EOLOK,1B23
T READ,EOLOK,1B25
T WRITE,EOLOK,1B24
TEND
..DELE: NOISE <files only>
CONFIRM
TLO F,1 ;SAY DELETED FILES ONLY
RET
.DOUBL: TLO F,2 ;SAY DOUBLE SPACE
RET
.EVERY: IOR E,[001111,,077741] ;ALL FIELDS THAT CAN BE PRINTED
RET ;THIS IS TOO MUCH TO FIT ONE TTY LINE.
.LENGT: NOISE <in bytes>
CONFIRM
TRO E,1B26 ;SAY PRINT LENGTH IN BYTES
RET
;.LPT $LPT $GTJFN LPT5 .OUTPU ..NO ..PROT .REVER .SEPAR ..SIZE ..TEN5 .VERBO
;DIRECTORY SUB-COMMANDS...
;"LPT" IS SHORT FOR "OUTPUT (TO) LPT:"
.LPT: CONFIRM
;"LIST" CALLS "$LPT" AS A SUBROUTINE TO ASSIGN A JFN TO LPT.
$LPT: MOVE B,[POINT 7,[ASCIZ /LPT:/],-1]
;"EDDT" CALLS $GTJFN WITH TEXT POINTER IN B.
$GTJFN: HLRZ A,JBUFP ;CHECK FIRST FOR JFN STACK SPACE
CAIN A,-1 ;WOULD PDL OV OCCUR AT NEXT PUSH?
ERROR <Too many JFN's in command>; YES.
HRLZI A,B2+B17 ;OLD FILES ONLY, SHORT GTJFN CALL.
GTJFN
CALL JERR
MOVE B,JBUFP
PUSH B,A
MOVEM B,JBUFP
LPT5: MOVEM A,OUTDSG ;JFN.
RET
.OUTPU: NOISE <to file>
MOVE A,[[ASCIZ /DIR/],,[ASCIZ /DIR/]] ;DEFAULT NAME & EXT
CALL COUTFN
JRST CERR
CONFIRM
JRST LPT5
..NO: NOISE (heading)
CONFIRM
TLO F,B13
RET
..PROT: TLO E,1 ;SAY PRINT PROTECTION
RET
.REVER: TRO Z,1 ;SAY LIST IN REVERSE ORDER
RET
.SEPAR: NOISE (lines for each version) ;MAINLY A DEBUGGING CMD
CONFIRM
TLO F,B14+B15
RET
..SIZE: TRO E,1B22
RET
..TEN5: TLO F,B11
RET
;TIMES: SEE PREVIOUS PAGE
.VERBO: IOR E,[001111,,066041] ;ALL BUT CREATION DATE, LEN. IN BYTES,
RET ;TIMES. FITS ON ONE TTY LINE.
;DHEAD DHEADX DHEADZ
;DHEAD
;TYPE HEADING, IF ANY, FOR DISK FILE DIRECTORY PRINTOUT.
;THIS ROUTINE MUST BE CHANGED WHENEVER DFILE'S FORMAT IS CHANGED!
;TAKES: OUTDSG: OUTJFN
; E: FIELDS TO PRINT BITS
; F: B13 TO SUPPRESS HEADING
DHEAD: PUSH P,A
MOVE A,DIRNO
CAMN A,OLDDIR
JRST DHEADZ ;NO CHANGE, FORGET HEADING
MOVEM A,OLDDIR
TLNN F,B10+B12+B13 ;"QFD","SUPP. HEAD." OR "DTA" FLAG ON?
TRNN E,777B30 ;NOTHING TO LIST AFTER ACCT FIELD?
JRST DHEADZ ;YES,NON-VERBOSE LISTINGS GET NO HEADING
PUSH P,B
PUSH P,C
MOVE A,OUTDSG
CALL DINDNT ;INDENT RIGHT AMT. FOR FIELDS TO PRINT
;PRINT HEADERS FOR THE COLUMNS TO BE INCLUDED IN THIS LISTING
SETZ C,
HRROI B,[ASCIZ /Pgs /]
TRNE E,1B22 ;SIZE IN PAGES
SOUT
HRROI B,[ASCIZ /Bytes(sz) /]
TRNE E,1B26 ;SIZE IN BYTES
CALL DHSOUT
HRROI B,[ASCIZ /Creation /]
TRNE E,1B23+1B27 ;CREATION DATE
CALL DHSOUT
HRROI B,[ASCIZ / /]
TRNE E,1B27 ;CREATION TIME
CALL DHSOUT
HRROI B,[ASCIZ /Write /]
TRNE E,1B24+1B28
CALL DHSOUT
HRROI B,[ASCIZ / /]
TRNE E,1B28
CALL DHSOUT
HRROI B,[ASCIZ /Read /]
TRNE E,1B25+1B29
CALL DHSOUT
HRROI B,[ASCIZ / /]
TRNE E,1B29
CALL DHSOUT
HRROI B,[ASCIZ /Author/]
TRNE E,1B30
SOUT
HRROI B,[ASCIZ /
/]
SOUT
DHEADX: POP P,C
POP P,B
DHEADZ: POP P,A
RET
;DINDNT DHSOUT
;DINDNT: SUBR TO INDENT THE RIGHT AMOUNT BEFORE HEADING,
; AS A FUNCTION OF FIELDS TO BE PRINTED.
;ALSO USED BY DFREST WHEN GOING TO A NEW LINE.
DINDNT: MOVEI B,TAB
BOUT ;NAME, EXT, VERSION CROSS FIRST TAB STOP
TLNE E,<3B17>B53 ;PROTECTION, IF REQUESTED IN PRINTOUT,
BOUT ;CROSSES ANOTHER TAB STOP.
TRNE E,3B20 ;ACCT CROSSES ANOTHER.
BOUT
TRNN E,1B32 ;UNLESS COLUMNATION SUPPRESSED,
BOUT ;FOLLOWING FIELDS BEGIN AT NEXT TAB STOP
RET
;DHSOUT: SOUT AND APPEND SPACE UNLESS COLUMNATION SUPPPRESSED (E B32 ON)
;FOR "DHEAD". CLOBBERS B.
DHSOUT: SOUT
MOVEI B," "
TRNN E,1B32
BOUT
RET
;DNAME DNAME4 DNAME5 DNAME6 DNAME8 DNAMEX
;DNAME
;SUBROUTINE TO TYPE DIRECTORY NAME IF "*" GIVEN
;FOR DIRECTORY OR IF MORE THAN ONE ARGUMENT
;IN LIST OR IF OUTPUT NOT TO TERMINAL.
DNAME: TLNE F,B13
RET ;HEADING SUPPRESSED
PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,OUTDSG ;DESTINATION
MOVE C,@INIFH1 ;JFN OF CURRENT ARG
CAMN C,[-2] ;FOR EMPTY DIR TYPE NOTHING
JRST DNAMEX ;RETURN
MOVE A,CSBUFP ;JFNS TO STRING BUFFER
MOVE B,OUTDSG ;OUTPUT JFN
CAME B,COJFN ;GOING TO OTHER THAN PRIMARY?
CALL SITEO ;OUTPUT SITE
MOVEI B,(C)
MOVE C,[2B2+1B5+1B35] ;DEFAULT DEV, PRINT DIR
TLNE F,B12
MOVE C,[2B2+1B35] ;DECTAPE: DEVICE ONLY
MOVE D,A ;SAVE BEG OF DIRECTORY NAME FOR BELOW
JFNS
CAMN A,CSBUFP
JRST DNAMEX ;NULL STRING, PRINT NOTHING
DNAME4: MOVE 2,OUTDSG
CAMN 2,COJFN ;GOING TO PRIMARY OUTJFN ?
JRST DNAME5 ;YES, NO DATE AND TIME
PUSH P,A ;SAVE PTR INTO CSBUF
HRROI 2,[ASCIZ / /] ;THREE SPACES
SETZM 3
SOUT
SETOM 2
ODTIM ;AND THE TIME
POP P,A ;RESTORE PTR TO END OF DIR NAME
DNAME5: TLNE F,B12
JRST [ SETOM OLDDIR ;DTA: BESURE HEADING, ETC WILL PRINT
JRST DNAME8]
DNAME6: SETZM B
DPB B,A ;FLUSH THE CLOSING LESS THAN SIGN
PUSH P,A
SETZM A
MOVE B,D ;PTR TO BEGINNING OF DIRECTORY
IBP B ;PASS THE OPENING GREATER THAN SIGN
STDIR
JFCL ;NO MATCH (CAN'T HAPPEN)
JFCL ;AMBIGUOUS (CAN'T HAPPEN)
POP P,B
MOVEI C,">"
DPB C,B ;PUT IT BACK
HRRZS A
MOVEM A,DIRNO ;REMEMBER DIRECTORY NUMBER
CAMN A,OLDDIR
JRST DNAMEX ;NO CHANGE, DON'T PRINT AGAIN
DNAME8: MOVE A,OUTDSG
SETZ C,
HRROI B,[ASCIZ / /]
SOUT ;INDENT FOR DIR NAME
MOVE B,CSBUFP
SOUT
HRROI B,[ASCIZ /
/]
SOUT
DNAMEX: POP P,C
POP P,B
POP P,A
RET
;$GTFDB FDBILI
;$GTFDB
;SUBROUTINE TO DO GTFDB JSYS AND SKIP UNLESS
;AN INSTRUCTION TRAP WITH "LIST ACCESS NOT ALLOWED"
;ERROR OCCURED.
;USED IN DIRECTORY, UNDELETE, DSKSTAT, COPY/APPEND, LIST/TYPE.
;SHOULD BE IN SAME PAGE AS DSKDIR CAUSE ITS IN A LOOP THERE.
$GTFDB: PUSH P, A
MOVEI A,FDBILI ;WHERE TO GO ON INST TRAP
MOVEM A, ILIDSP
POP P,A
GTFDB
SETZM ILIDSP ;CLEAR SPECIAL INST TRAP DISPATCH
AOS (P)
RET
;TRAP OCCURRED, CHECK ERROR CODE
FDBILI: PUSH P,A
HRRZ A,ERCOD
CAIE A,GFDBX3 ;"LIST ACCESS NOT ALLOWED"?
JRST [ POP P,A
JRST ILIPSI] ;NO,TREAT AS OTHER ILL INST TRAPS.
JRST [ POP P,A
RET]
;DSKDIR
;DSKDIR
;SUBROUTINE TO LIST DISK OR DECTAPE DIRECTORY
;READS (WITH GNJFN),SORTS,PRINTS ONE DIRECTORY
;TAKES: A: SOURCE DEVICE DESIGNATOR FOR DECTAPE
; OUTDSG: DESTINATION JFN
; INIFH1: POINTER TO INDEXABLE FILE HANDLE
; Z,E,F: VARIOUS FLAGS, SEE COMMENTS AT
; BEGINNING OF "DIRECTORY", INCL F B12 FOR DECTAPE.
;RETURNS F2 SET IF ADDITIONAL FILES ARE TO BE LISTED
; FOR CURRENT INDEXABLE FILE HANDLE.
;CLOBBERS A-D,G-GG.
;BUFFER DEFINITIONS
DTADRC==BUF1 ;WHERE DECTAPE DIRECTORY IS READ
DTATBL==BUF1+200 ;TABLE FOR DECTAPE FILE LENGTHS
TABLE=BUF2 ;WHERE SYMBOL TABLE IS BUILT
TABLEN==777 ;LENGTH OF TABLE. CANNOT
;BE GREATER THAN 511.
DIRBUF=TABLE+TABLEN ;BOTTOM OF STRING AND FDB STORAGE
;SUCCESSIVE PAGES UPWARD FROM BUF1 ARE USED.
;THERE ARE ENOUGH PAGES BELOW DDT AS LONG
;AS DIRECTORY LENGTH REMAINS LIMITED TO 4K.
DSKDIR: TLNN F,B12 ;DECTAPE?
JRST DSKD2 ;NO
TLNE F,B11 ;TEN50 FORMAT REQUESTED?
JRST OLDTAD ;YES, USE OLD ROUTINE.
TRNN Z,36 ;ORDERING SPECIFIED?
TRO Z,1B34 ;NO, DEFAULT TO ALPHABETIC
;DSKD2
;DSKDIR...
;DECTAPE SPECIFIC PROCESSING.
;FORMAT OF THE DIRECTORY BLOCK ON DECTAPE:
; WORDS 0-82: 5-BIT "SLOTS", 1 PER BLOCK: 0 FREE,
; 1-22 FILE NUMBER
; 27 DIRECTORY & TENDUMP BLOCKS
; WORDS 83-104: NAMES OF FILES 1-22
; WORDS 105-126: LH: EXT. B24-35: WRITE DATE.
;READ DIRECTORY
MOVEI B,DTADRC ;WHERE TO READ IT. DEV DESIG STILL IN A.
RDDIR ;READ IT
CALL [ CAIN A,RDDIX1
UERR [ASCIZ /Trouble reading directory,
maybe DECtape not on "remote"/]
JRST JERR]
;SCAN "SLOTS" PORTION OF DIRECTORY, COUNTING BLOCKS IN FILES
MOVE B,[POINT 5,DTADRC,-1] ;5 BITS PER BLOCK ON TAPE
MOVEI C,↑D578 ;# BLOCKS ON TAPE
ILDB D,B ;FETCH A SLOT BYTE
AOS DTATBL(D) ;INDEX APPROPRIATE TABLE WORD
SOJG C,.-2
;TYPE # FREE BLOCKS
;SUPPRESS IF NOT LISTING WHOLE DIRECTORY ??
TRNE E,1B32
JRST DSKD2 ;OMIT IN CRAM FORMAT (QFD)
MOVE A,OUTDSG
HRROI B,[ASCIZ /
/]
SETZ C,
TLNE F,B16
SOUT ;EXTRA CRLF IF DOUBLE-SPACING
MOVEI B," "
BOUT
MOVE B,DTATBL+0
MOVEI C,↑D10
NOUT
CALL JERRC
HRROI B,[ASCIZ / free blocks
/]
SETZ C,
SOUT
DSKD2: CALL DHEAD ;PRINT COLUMN HEADS IF APPROPRIATE
MOVE A,OUTDSG
HRROI B,[ASCIZ /
/]
SETZ C,
TLNE F,B16
SOUT ;EXTRA CRLF IF DOUBLE-SPACING
;DSKR1
;DSKDIR ...
;READ FDB, NAME, EXT OF EACH FILE TO LIST,
;LOOPING OVER FILES WITH GNJFN, STOPPING IF DEVICE OR
;DIRECTORY CHANGES.
;IN FDB PUT POINTERS TO NAME, EXT, AND ACCT STRINGS.
;FOR DECTAPE FILES A DUMMY FDB CONTAINING NAME, EXT, WRITE DATE,
; # BLOCKS, AND THE REST 0 IS BUILT
;FORM TABLE OF POINTERS TO FDB'S STARTING AT "TABLE".
;LH OF EACH POINTER WORDS HAS 9-BIT REVERSE AND
;FORWARD LIST POINTERS TO PERMIT SORTING IN PLACE
;AND LISTING IN FORWARD OR REVERSE ORDER.
;WORD TABLE +0 IS A DUMMY, WITH FORWARD POINTER
;TO HEAD OF LIST, REVERSE POINTER TO END, AND
;0 RH TO TERMINATE SORT AND PRINT OPERATIONS.
;FIRST ENTRY IN LIST HAS 0 REV PTR, LAST HAS 0 FWD PTR.
MOVEI GG,0 ;INITIALIZE TABLE INDEX
MOVEI C,DIRBUF ;INITIALIZE BUFFER SPACE POINTER
MOVE A,@INIFH1
CAMN A,[-2] ;IS IT A COMPLETELY EMPTY DIRECTORY ?
JRST DSKR9 ;YES.
;TOP OF LOOP
;CHECK FOR TABLE FULL, IF SO PRINT MULTIPLE PARTIAL DIRECTORIES
DSKR1: CAIG C,767720
CAIL GG,TABLEN-2 ;BOTH ENDS MUST HAVE 0'S
JRST [ UTYPE [ASCIZ / Storage full,
Directory will be printed in two sections
/]
JRST DSKR8] ;GO SET F2, LIST THIS MUCH.
;DSKR2
;DSKDIR... READ...
;READ AND STORE FDB AND STRINGS FOR A FILE
TLNE F,B12
JRST DSKR2 ;FOR DTA LEAVE A 0 BLOCK FOR "FDB"
HRRZ A,@INIFH1 ;JFN
MOVE B,[16,,0] ;FDB THRU "FDBCRV"
;C ALREADY SET RIGHT
CALL $GTFDB ;DO GTFDB JSYS AND SKIP UNLESS(β⊂∞.
JRST [ TLO Z,F1 ;LIST ACCESS NOT ALLOWED
JRST DSKR7] ;FLAG INVOKES MSG LATER
MOVE A,FDBCTL(C) ;CONTROL BITS WORD OF FDB
TLNE F,B17 ;"DELETED FILES ONLY" REQUESTED?
TLC A,<FDBDEL>B53 ;YES,COMPLEMENT "DELETED" BIT
TLNE A,<FDBDEL>B53 ;THIS FILE DELETED OR NOT AS REQUESTED?
JRST DSKR7 ;NO SKIP IT.
DSKR2: MOVE D,C ;WHERE THIS FDB IS
HRROI A,16(D) ;CREATE STRING POINTER PAST FDB
HRRM A,FDBCTL(D) ;NAME POINTER TO FDB
HRRZ B,@INIFH1 ;JFN
HRLZI C,B8 ;FORMAT
JFNS ;GET NAME STRING
HRROI A,2(A) ;STRING PTR TO BEG OF NEXT WORD TO USE
;LEAVES A 0 WORD TO TERMINATE
;STRING FOR SORT.
HRLM A,FDBEXT(D) ;EXT PTR TO FDB
HRLZI C,B11
JFNS ;EXTENSION STRING
;; MOVE B,FDBACT(D) ;ACCOUNT
;; JUMPLE B,DSKR4 ;NUMERIC OR MISSING
;; HRROI A,2(A)
;; HRRZM A,FDBACT(D)
;; HRRZ B,@INIFH1
;; MOVEI C,1B20
;; JFNS ;GET ACCOUNT STRING
;DSKR4 DTADRN DTADRE DTADR1 DTADR9
DSKR4: MOVEI C,2(A) ;WHERE TO STORE NEXT FDB
;AGAIN LEAVING A 0 WORD POINTER
TLNN F,B12
JRST DSKR5
;FOR DTA PICK UP DATE AND SIZE
;SEARCH DIRECTORY TO GET DATE (IN SAME WORD AS EXT)
;AND SIZE (AT SAME INDEX INTO DTATBL).
HRLZI AA,-↑D22
;CONVERT NAME AND EXT FROM "FDB" TO SIXBIT IN BB, CC.
;CLOBBERS BB-FF.
HRLI EE,<POINT 7,0,-1>B53 ;NAME
HRR EE,FDBCTL(D)
MOVEI FF,6
DTADRN: ILDB CC,EE ;NAME CHAR LOOP
JUMPE CC,.+2
SUBI CC,40
LSH CC,36
LSHC BB,6
SOJG FF,DTADRN
HRLI EE,<POINT 7,0,-1>B53 ;EXTENSION
HLR EE,FDBEXT(D)
MOVEI FF,3
DTADRE: ILDB DD,EE ;EXT CHAR LOOP
JUMPE DD,.+2
SUBI DD,40
LSH DD,36
LSHC CC,6 ;EXT ENDS UP IN RH CC, GARBAGE IN LH.
SOJG FF,DTADRE
DTADR1: CAME BB,DTADRC+↑D83(AA)
JRST DTADR9 ;WRONG NAME
HRLZ B,CC ;EXT,,0 FROM "FDB"
XOR B,DTADRC+↑D105(AA) ;COMPARE EXT, PICK UP DATE FROM DTADRC
PUSH P,C
ANDCMI B,7B23
MOVEI C,1B35 ;NEW DEC DATE STANDARD
TDNE C,DTADRC+0(AA) ;PICK UP THREE EXTRA BITS
TRO B,1B23
TDNE C,DTADRC+↑D22(AA)
TRO B,1B22
TDNE C,DTADRC+↑D44(AA)
TRO B,1B21
POP P,C
TLNE B,-1
JRST DTADR9 ;WRONG EXT
DPB B,[POINT 15,FDBWRT(D),35] ;DATE TO "FDB"
MOVE B,DTATBL+1(AA)
HRRM B,FDBBYV(D) ;SIZE IN BLOCKS
JRST .+2
DTADR9: AOBJN AA,DTADR1 ;IF NOT FOUND LEAVE THINGS 0
;DSKR5 DSKR7 DSKR8 DSKR9
;DSKDIR... READ...
;MAKE TABLE ENTRY
DSKR5: DPB GG,[POINT 9,TABLE+1(GG),8] ;REVERSE POINTER
;TO ENTRY WE ARE ABOUT TO USE
MOVEI GG,1(GG) ;INCREMENT TABLE INDEX
DPB GG,[POINT 9,TABLE-1(GG),17] ;FORWARD POINTER
;TO PREVIOUS ENTRY
;LEAVES 0 IN LAST ENTRY.
HRRM D,TABLE(GG) ;PTR TO FDB TO THIS TABLE ENTRY
;STEP TO NEXT FILE, STOP IF ANOTHER DEVICE OR DIRECTORY
DSKR7: MOVE A,@INIFH1
TLNE A,<77B5>B53 ;IF NO *-FLAGS SKIP GNJFN
GNJFN
JRST DSKR9 ;NO MORE,DONE READING
TLNN A,70 ;DEVICE OR DIRECTORY CHANGED?
JRST DSKR1 ;NO,DO THIS FILE.
DSKR8: TLO Z,F2 ;YES,SAY THERE'S MORE FOR THIS JFN,
;SORT AND PRINT WHAT WE HAVE
DSKR9: DPB GG,[POINT 9,TABLE,8];PUT "REVERSE" POINTER
;TO LAST ENTRY IN DUMMY ENTRY 0.
;USED FOR REVERSE UNSORTED LISTING.
TRNN Z,36 ;ANY ORDER-OF-PRINTOUT FLAGS ON?
JRST DSKP ;NO, NO SORT REQUIRED, GO PRINT
;DSKS1 GRATR LESS HERE
;DSKDIR...
;SORT DISK DIRECTORY
;FOR EACH SUCCESSIVE WORD OF UNSORTED TABLE, FIND
;PLACE TO PUT IT IN LIST-STRUCTURED TABLE, STARTING
;FROM LAST INSERTED ENTRY TO MAKE MAXIMUM
;USE OF PARTIAL ORDERING.
;ENDS OF LIST ARE INDICATED BY 0 RH OF TABLE WORD.
;START WITH ZEROED WORD 0; THIS PUTS POINTERS TO IT
;(AS TERMINATING ENTRY) AT EACH END OF LIST.
SETZM TABLE ;INITIALIZE SORTED TABLE:
;MAKES LAST FIND AND FIRST REV
;PTR POINT TO A WORD (NAMELY THIS WORD)
;WITH 0 RH.
MOVEI GG,0 ;INDEX OF CURRENT (LAST INSERTED)
;SORTED TABLE ENTRY
MOVEI ;INDEX INTO UNSORTED TABLE
;TOP OF LOOP
DSKS1: SKIPN TABLE(AA)
JRST DSKP ;NO MORE TO SORT, GO PRINT
CALL FDBSC ;COMPARE ENTRY (GG) TO (AA),3 RETURNS
JRST LESS ;UNSORTED ENTRY (GG) LESS
JRST HERE ;EQUAL
;UNSORTED ENTRY GREATER, SEARCH FORWARD
GRATR: LDB GG,[POINT 9,TABLE(GG),17] ;GET FWD PTR
CALL FDBSC ;COMPARE AGAIN
JRST .+3 ;LESS
JRST .+2 ;EQUAL OR AT END OF TABLE
JRST GRATR ;GREATER, KEEP SEARCHING
;LESS OR EQUAL, PUT IT BEFORE THIS ONE
LDB GG,[POINT 9,TABLE(GG),8] ;BACK UP 1
JRST HERE ;PUT IT AFTER THIS ONE
;UNSORTED ENTRY LESS, SEARCH BACKWARD
LESS: LDB GG,[POINT 9,TABLE(GG),8] ;GET REVERSE PTR
CALL FDBSC
JRST LESS ;KEEP SEARCHING
JRST HERE ;EQUAL OR BEGINNING OF TABLE
;INSERT ENTRY AFTER CURRENT ENTRY BY UPDATING LIST POINTERS
HERE: LDB A,[POINT 9,TABLE(GG),17] ;SORTED ENTRY'S FWD PTR
DPB A,[POINT 9,TABLE(AA),17] ;TO ENTRY BEING INSERTED
DPB AA,[POINT 9,TABLE(GG),17] ;SET FWD PTR OF
;SORTED ENTRY TO POINT AT NEW ENTRY
DPB AA,[POINT 9,TABLE(A),8] ;SET REV PTR OF ENTRY
;FOLLOWING SORTED ENTRY TO POINT AT NEW ENTRY
DPB GG,[POINT 9,TABLE(AA),8] ;SET NEW ENTRY'S REV
;PTR TO POINT PREVIOUS SORTED ENTRY
MOVE GG,AA ;ENTRY JUST INSERTED IS CURRENT
AOJA AA,DSKS1 ;BOTTOM OF LOOP: NEXT UNSORTED ONE
;FDBSC
;DSKDIR...
;SUBROUTINE FDBSC FOR SORT
;COMPARE FDB'S THAT TABLE ENTRIES SPECIFIED BY INDICES
;IN GG AND AA POINT TO.
;RETURN+1 IF GG LESS, +2 =, +3 GREATER
;ACCORDING TO SORT KEY SPECIFIED BY FLAGS IN RHZ
;RET +2 IF GG POINTS TO NULL TABLE ENTRY.
;CLOBBERS A - D, G, BB.
FDBSC: HRRZ BB,TABLE(GG) ;BB POINTS TO FIRST FDB
HRRZ G,TABLE(AA) ;G TO SECOND
JUMPE BB,FDBEQ ;NULL, RETURN AS THOUGH EQUAL.
TRNN Z,1B34
JRST FDBSC2
;ALPHABETIC COMPARISON.
HRRZ A,FDBCTL(BB) ;NAME PTRS
HRRZ B,FDBCTL(G)
CALL FDBSTC ;STRING COMPARE RETURNS HERE
;ONLY IF EQUAL.
;NAMES =, COMPARE EXTENSIONS
HLRZ A,FDBEXT(BB)
HLRZ B,FDBEXT(G)
CALL FDBSTC
;=, COMPARE VERSIONS
HLRZ A,FDBVER(BB)
HLRZ B,FDBVER(G)
JRST FDBSC3 ;JOIN CHRONOLOGICAL CASE FOR COMPARE
;FDBSC2 FDBSC3 FDBGR FDBEQ FDBLS
;DSKDIR SORT SUBR FDBSC...
;FOR EACH CHRONOLOGICAL COMPARISON FETCH THE DATES AND TIMES
;TO COMPARE THEN CONVERGE ON COMPARE
FDBSC2: TRNN Z,1B31
JRST .+4
MOVE A,FDBWRT(BB) ;WRITE
MOVE B,FDBWRT(G)
JRST FDBSC3
TRNN Z,1B32
JRST .+4
MOVE A,FDBRED(BB) ;READ
MOVE B,FDBRED(G)
JRST FDBSC3
TRNN Z,1B33
JRST FDBGR ;NO SORTING SPEC. (IE DIRECTORY ORDER)
;TREAT AS THO GREATER. NOTE THAT
;"REVERSE" STILL WORKS
;THIS IS WHERE TO ADD CASES
MOVE A,FDBCRV(BB) ;CREATE
MOVE B,FDBCRV(G)
FDBSC3: CAMN A,B
JRST FDBEQ
CAML A,B ;RETURN "GREATER" IF DATE LESS
JRST FDBLS ;BECAUSE DEFAULT ORDER IS
JRST FDBGR ;REVERSE CHRONOLOGICAL
FDBGR: AOS (P)
FDBEQ: AOS (P)
FDBLS: RET
;FDBST1 FDBSTC
;DSKDIR... SORT...
;FDBSTC: STRING COMPARE FOR FDBSC.
;A AND B POINT TO STRING BLOCKS WITH
;HEADER WORD AND 0 WORD AFTER.
;RETURNS IF =, ELSE GOES TO FDBLS OR FDBGR.
;CLOBBERS A-D.
FDBST1: SKIPN (A) ;WORDS =. END OF STRINGS?
RET ;YES, STRINGS =.
MOVEI A,1(A)
MOVEI B,1(B)
;ENTER HERE
FDBSTC: JCRY0 .+1
MOVE C,(A) ;FETCH WORD OF FIRST STRING
;PASSING HEADER WORD.
SUB C,(B) ;SUBTRACT WORD OF 2ND STRING
JUMPE C,FDBST1 ;WORDS =?
JCRY0 [ SUB P,[1,,1] ;FORGET RETURN
JRST FDBLS]
SUB P,[1,,1]
JRST FDBGR
;DSKP DSKP1 DSKP4 DSKP5
;DSKDIR...
;PRINT DISK DIRECTORY
DSKP: SETZM LPNAME
SETZM LPEXT
SETZM LPFDB
;COPY FLAGS APPROPRIATE TO DEVICE FORM E TO BB
MOVE BB,E ;ALL FOR DISK
TLNE F,B12
AND BB,[7B8+7B11+1B22+1B24+1B28];DECTAPE
MOVEI GG,0 ;GG IS TABLE POINTER
;WORD TABLE+0 IS A DUMMY,
;NOT TO BE LISTED
DSKP1: TRNN Z,1 ;SKIP IF REVERSE ORDER
LDB GG,[POINT 9,TABLE(GG),17] ;FWD POINTER
TRNE Z,1 ;SKIP IF NORMAL ORDER
LDB GG,[POINT 9,TABLE(GG),8] ;REVERSE PTR
HRRZ G,TABLE(GG) ;FDB PTR FROM TABLE ENTRY
JUMPE G,DSKP4 ;0 MEANS END
CALL DFILE ;LIST THIS ENTRY
JRST DSKP1
DSKP4: CALL DFREST ;PRINT REST OF LAST LINE
TLZN Z,F1 ;ANY LIST ACCESS ERRORS?
JRST DSKP5
TLNN Z,GROUPF
TYPE < List protect violation
>; FOR A SINGLE FILE
TLNE Z,GROUPF
TYPE < Plus file(s) that are list protected from you
>;
DSKP5: RET ;RETURN FROM DSKDIR
;DFILE
;LIST ONE FILE
;TAKES: OUTDSG: OUTPUT JFN
; BB: WHAT FIELDS TO PRINT BITS -- SAME AS JFNS'S EXCEPT
; COMBINATIONS NOT PRODUCED BY "DIRECTORY" COMMAND AREN'T
; NECESSARILY HANDLED.
; AND ALSO: B26: PRINT LENGTH IN BYTES.
; B27-30: CREATE, WRITE, READ TIMES (IMPLYING DATES)
; B32: SUPPRESS COLUMNATION
; F: B14: DON'T PUT MULTIPLE VERSIONS OF SAME NAME.EXT
; ON SAME LINE
; B15: SUPPRESS THE NORMAL OMISSION OF NAME OR NAME.EXT
; WHEN SAME AS THOSE LAST PRINTED
; B16: ON FOR DOUBLE-SPACING
; B17: ON TO LIST DELETED FILES ONLY
; G: POINTER TO FDB
;AC USE
; D: # COLS MIN TO USE FOR CURRENT FIELD / RUNNING NEGATIVE
; TOTAL OF PREVIOUS FIELD OVERFLOW COLUMNS (SEE "DFILL").
;CLOBBERS A, B, C, D.
;DFILE DFL02B
;DFILE
DFILE: MOVE A,OUTDSG
SETZ D, ;NO FIELDS HAVE EXCEEDED MIN WIDTH YET
;NAME, EXTENSION, VERSION
HRRZ B,FDBCTL(G) ;NAME
; IF NAME IS SAME AS THAT LAST PRINTED, JUST PRINT 3 SPACES.
TLNE F,B15
JRST DFL03A ;FLAG SUPPRESSES COMPACT FORMAT
SKIPE C,LPNAME ;LAST NAME PRNTD. NONE MEANS "DIFFERENT"
CALL DCMPR ;COMPARE CURRENT NAME TO LAST PRINTED
JRST DFL03A ;DIFFERENT, PRINT IT.
HLRZ B,FDBEXT(G)
SKIPE C,LPEXT
CALL DCMPR ;NAME IS SAME, IS EXT SAME ALSO?
JRST [ CALL DFREST ;FINISH PREVIOUS LINE, IF ANY.
MOVE B,[POINT 7,[ASCIZ / /],-1] ;NAME SAME, EXT DIFF
AOJA D,DFL03B] ;PRINT SPACES AND PROCEED TO EXTENSION
;NAME AND EXTENSION ARE THE SAME AS THOSE LAST PRINTED.
;NORMALLY PUT COMMA AND ADDITIONAL VERSION ON SAME LINE UNLESS
; SOME OTHER FIELD TO BE PRINTED IS DIFFERENT,
; BUT IF THAT IS SUPPRESSED OR A FIELD IS DIFFERENT,
; START NEW LINE WITH TAB INSTEAD OF NAME.EXT.
TLNE F,B14
JRST DFL02B ;MULTIPLE VERSIONS PER LINE SUPPRESSED
;COMPARE CURRENT FDB TO PREVIOUS, COMPARING ONLY THOSE
; FIELDS WHICH ARE TO BE PRINTED.
CALL DFDBCM
JRST DFL02B ;DIFFERENT, NEW LINE.
MOVE D,LFPOS ;SAME, RETRIEVE "POSITION" ON THIS LINE
MOVEI B,"," ;USE A COMMA,
SOJA D,DFL05A ;ACCOUNT COLUMN USED BY COMMA,
;AND GO PRINT VERSION ON SAME LINE.
;FINISH OLD LINE AND START NEW FOR SAME NAME.EXT
DFL02B: CALL DFREST ;PRINT REST OF LAST FILE'S INFO, IF ANY
MOVEI D,↑D8 ;8 COLS IF COLUMNATION NOT SUPPRESSED,
HRROI B,[ASCIZ / /] ;ONE SPACE IF IT IS SUPPRESSED.
CALL DFILL ;SPACES(S) IN PLACE OF NAME.EXT
JRST DFL05 ;GO PRINT VERSION
;DFL03A DFL03B DFL05 DFL05A
;DFILE...
;PRINT NAME
DFL03A: CALL DFREST ;PRINT REST OF PREVIOUS LINE, IF ANY
MOVEI B," "
BOUT ;SPACE AT BEGINNING OF EACH LINE
HRRO B,FDBCTL(G) ;NAME BLOCK RELATIVE LOCATION
HRROM B,LPNAME ;REMEMBER LAST PRINTED NAME
DFL03B: ADDI D,3 ;USE 3 COLUMNS MINIMUM
CALL DFILL ;PRINT NAME OR SPACES
;PRINT EXTENSION
HLRO B,FDBEXT(G) ;EXT
HRROM B,LPEXT ;REMEMBER LAST PRINTED EXTENSION
PUSH P,B
MOVEI B,"." ;"." IS NORMAL SEPARATOR
BOUT
POP P,B ;EXT PTR AGAIN
ADDI D,3 ;# COLS TO USE: 3 - EXTRAS USED FOR NAME
CALL DFILL ;OUTPUT EXTENSION
;PRINT FIRST VERSION ON LINE
DFL05: MOVEI B,";"
DFL05A: TLNE BB,<1B14>B53 ;SUPPRESS FOR DTA
BOUT ;ADDIT'L VERSION ON SAME LINE JOINS HERE
HLRZ B,FDBVER(G) ;VERSION
MOVEI C,↑D10
TLNE BB,<1B14>B53
CALL DFNOUT ;NOUT AND KEEP TRACK OF COLS USED.
MOVEM G,LPFDB ;SAVE FDB ADDRESS FOR "DFREST"
MOVEM D,LFPOS ;LINE "POSITION" (- # COLS OV) ALSO
RET
;PRINTING OF ADDITIONAL FIELDS FOR THIS NAME.EXT;VERSION IS DEFERRED
; SO THAT ADDITIONAL VERSION NUMBERS MAY BE PRINTED HERE,
; SEPARATED BY COMMAS.
;DFREST DFR06A
;DFREST
;LIST REST OF FIELDS AFTER VERSION NUMBER
;CALLED FROM DFILE WHEN A DIFFERENT VERSION NUMBER IS DETECTED,
; AND AT END OF LISTING.
;TAKES: LPFDB: ZERO OR POINTER TO FDB FOR WHICH TO FINISH PRINTOUT
; LFPOS: - # COLS LINE OVERFLOW, AS REQUIRED FOR "DFILL"
; OUTDSG,E,F: AS FOR "DFILE" ABOVE.
;RETURNS: LPFDB 0, B,C CLOBBERED, D-G PRESERVED.
DFREST: SKIPN LPFDB
RET ;NOTHING TO PRINT REST OF, RETURN.
PUSH P,D
PUSH P,G
MOVE A,OUTDSG
MOVE G,LPFDB ;LOCATION OF FDB
MOVE D,LFPOS ;LINE OVERFLOW SITUATION
SETZM LPFDB ;MAKE SURE IT ISN'T LISTED AGAIN
;PROTECTION
TLNN BB,<3B17>B53
JRST DFR07 ;PRINTING PROTECTION NOT REQUESTED
HRROI B,[ASCIZ /;P/]
SETZ C,
SOUT
HLRZ B,FDBPRT(G) ;LEFT HALF OF PROTECTION WORD
CAIE B,500000 ;500000 MEANS 18-BIT OCTAL IN RH
JRST DFR06A ;0 MEANS STRING PTR
HRRZ B,FDBPRT(G)
MOVEI C,10
CALL DFNOUT ;NOUT AND KEEP TRACK OF COLUMNS USED
JRST DFR07
DFR06A: HRROI B,[ASCIZ /Fancy protection/]
CALL DFILL ;DFILE WILL HAVE TO BE MODIFIED WHEN
;HAIRY PROTECTION IS IMPLEMENTED. ←←←←←
;DFR07 DFR08 DFR85
;DFREST...
;ACCOUNT
DFR07:;; TRNN BB,3B20
JRST DFR08
;; HRROI B,[ASCIZ /;A/]
;; SETZ C,
;; SOUT
;; MOVE B,FDBACT(G)
;; JUMPL B,DFR07A
;STRING ACCOUNT
;; SKIPN FDBACT(G) ;"NONE" FOR NO BLOCK # OR PTR FOUND
;; HRROI B,[ASCIZ /None/]
;; HRROI B,0(B) ;MAKE PROPER LH
;; CALL DFILL ;PRINT THE STRING
;; JRST DFR08
;NUMERIC ACCOUNT
;;DFR07A: TLZ B,700000 ;CLEAR HI BITS.
;; MOVEI C,↑D10 ;DECIMAL
;; CALL DFNOUT ;NOUT AND KEEP TRACK OF CHRS OUTPUT
; ;T: ALWAYS PRINTED IF FILE IS TEMPORARY.
; ;S: ALWAYS PRINTED IF FILE IS SCRATCH
DFR08: MOVE B,FDBCTL(G) ;CONTROL BITS
TLNN B,<FDBTMP>B53 ;IS FILE TEMP?
JRST DFR85
HLRZ C,FDBVER(G)
CAIGE C,↑D100000 ;SCRATCH?
HRROI B,[ASCIZ /;S/]
CAIL C,↑D100000
HRROI B,[ASCIZ /;T/]
CALL DFILL ;SOUT AND KEEP TRACK OF COLUMNS
; ;E: ALWAYS PRINTED IF FILE IS EPHEMERAL
DFR85: MOVE B,FDBCTL(G)
TLNN B,(FDBEPH)
JRST DFR09
HRROI B,[ASCIZ /;E/]
CALL DFILL ;SOUT AND KEEP TRACK OF COLUMNS IN D
;DFR09 DFR09A DFR09C DFR09D
;DFREST...
DFR09: TRNN BB,777B30 ;ANY TIMES, ETC. TO PRINT?
JRST DFRXIT ;NO
;BEFORE PRINTING THE REST SPACE OVER TO THE APPROPRIATE TAB STOP,
;OR PRINT ONE SPACE IF BEYOND IT, OR USE A NEW LINE IF TOO FAR BEYOND.
TRNN BB,1B32 ;NEVER AN EOL IF COLUMNATION SUPPRESSED
CAML D,[-35] ;TO MUCH LINE OVERFLOW?
;-35 WAS CHOSEN BECUASE IT IS ONE CHARACTER SHORT OF PUSHING
;DATES CLEAR INTO NEXT COLUMN WHEN ;A AND ;P ARE PRESENT.
JRST DFR09A ;OK
MOVEI B,CR
BOUT
MOVEI B,LF
BOUT
CALL DINDNT ;INDENT THE RIGHT AMOUNT ON NEW LINE
SETZ D, ;NO LINE OVERFLOW NOW
JRST DFR09C
DFR09A: HRROI B,[ASCIZ / /] ;THE ONE SPACE
ADDI D,7 ;RIGHT # COLS BEYOND MIN FOR NAM.EXT;VER
TLNE F,B12
SUBI D,2 ;2 COLS NARROWER FOR DECTAPE
TLNE BB,<3B17>B53
ADDI D,6 ;ANOTHER TAB STOP FOR PROT
TRNE BB,3B20
ADDI D,6 ;";A" AND ";P NOT COUNTED IND
CALL DFILL ;SOUT AND ADD SPACES
;SIZE IN PAGES OR DECTAPE BLOCKS
DFR09C: TRNN BB,1B22
JRST DFR09D
HRRZ B,FDBBYV(G) ;SIZE IN PAGES
MOVEI C,↑D10 ;DECIMAL
CAIGE B,↑D1000 ;WILL FIT IN 3 COLS?
HRLI C,(1B2+3B17) ;YES, RIGHT JUSTIFY IT
ADDI D,3 ;3 COLS MIN WIDTH, LESS PRECEDING OVFLO
CALL DFNOUT ;NOUT WITH FANCY COLUMNATION
MOVEI B," "
BOUT
BOUT
;LENGTH IN BYTES: PRINT "LENGTH(SIZE)"
DFR09D: TRNN BB,1B26
JRST DFR10
MOVE B,FDBSIZ(G)
MOVEI C,↑D10 ;DECIMAL
CALL DFNOUT ;NO COLUMNATION YET
MOVEI B,"("
BOUT
LDB B,[POINT 6,FDBBYV(G),11] ;BYTE SIZE
MOVEI C,↑D10
CALL DFNOUT
MOVEI B,")"
BOUT
HRROI B,[ASCIZ / /] ;NOW A SEPARATING SPACE, PLUS ENOUGH MORE
ADDI D,↑D9 ;SO "SIZE(LENGTH)" TAKES UP 10 COLS,
CALL DFILL ;( 10 - ()'S+" "=9)
;LESS EXCESS USED BY NAME.
;DFR10 DFR11 DFR12 DFR129 DFR13 DFRXIT
;DFREST...
;THE VARIOUS DATES AND TIMES
DFR10: SETZ C, ;FORMAT: DD-MMM-YY HH:MM:SS
TRNE BB,1B32 ;SUPPRESS COLUMNATION?
TLO C,B17 ;SUPPRESS COLUMNATION.
TRNN BB,1B23+1B27
JRST DFR11
TRNN BB,1B27 ;TIME TO BE INCLUDED?
TLO C,B9 ;NO, EXCLUDE IT
MOVE B,FDBCRV(G) ;VERSION CREATION DATE & TIME
ODTIM ;PRINT DATE AND MAYBE TIME.
MOVEI B," "
BOUT
DFR11: TRNN BB,1B24+1B28
JRST DFR12
TLZ C,B9
TRNN BB,1B28
TLO C,B9
MOVE B,FDBWRT(G) ;WRITE DATE
TLNE F,B12
JRST [ CALL DTADAT ;PRINT DECTAPE FORMAT DATE
JRST DFR12]
ODTIM
MOVEI B," "
BOUT
DFR12: TRNN BB,1B25+1B29
JRST DFR129
SKIPN B,FDBRED(G)
JRST [ HRROI B,[ASCIZ / Not read/]
MOVEI C,0
SOUT
TRNE BB,1B29 ;TIMES BEING PRINTED...
TRNE E,1B32 ;AND NOT IN CRAM MODE?
JRST DFR129 ;NOT SO.
HRROI B,[ASCIZ / /]
SOUT ;YES
JRST DFR129]
TLZ C,B9
TRNN BB,1B29
TLO C,B9
ODTIM
DFR129: TRNE E,1B30 ;GOING TO PRINT AUTHOR?
TLNE F,(1B12) ;AND NOT DECTAPE
JRST DFRXIT ;NO.
MOVEI B," " ;YES, PRINT A SPACE
BOUT
DFR13: HLRZ B,FDBUSE(G) ;DIR NUM OF WRITER
MOVEI C,10
DIRST
NOUT
JFCL
;CRLF AND EXIT
DFRXIT: HRROI B,[ASCIZ /
/]
SETZ C,
SOUT
HRROI B,[ASCIZ /
/]
TLNE F,2 ;DOUBLE-SPACE?
SOUT ;YES, ANOTHER EOL.
POP P,G
POP P,D
RET
;DTADAT
;SUBROUTINE DTADAT: PRINTS DECTAPE FORMAT DATE FROM B.
;USED IN DFREST, OLDTAD.
;TAKES: A: DESTINATION, B: DATE. CLOBBERS C,D.
DTADAT: PUSH P,E
MOVE D,B
IDIVI D,↑D31
HRLZ C,E ;DAY OF MONTH
IDIVI D,↑D12
HRR B,E ;MONTH
HRLI B,↑D1964(D) ;YEAR
HRLZI E,B9 ;SUPPRESS TIME
ODTNC ;OUTPUT DATE WITHOUT CONVERSION FROM INTERNAL
POP P,E
RET
;DCMPR DCMPR1 DCMPR9
;DCMPR: SUBOUTINE FOR DFILE.
;COMPARE STRING C POINTS TO TO STRING B POINTS TO.
;SKIP IF EITHER POINTER IS ZERO OR IF STRINGS ARE SAME.
DCMPR: JUMPE C,[AOS (P)
RET]
JUMPE B,[AOS (P)
RET]
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
HRLI B,<POINT 7,0,-1>B53
HRLI C,<POINT 7,0,-1>B53
DCMPR1: ILDB E,C
ILDB D,B
CAME E,D
JRST DCMPR9 ;DIFFERENT
JUMPN E,DCMPR1 ;TERMINATE ON NULL
AOS -4(P)
DCMPR9: JRST [ POP P,E
POP P,D
POP P,C
POP P,B
RET]
;DFDBCM DFDC10
;DFDBCM: COMPARE FDB'S POINTED TO BY G AND LPFDB
;COMPARE ONLY FIELDS TO BE PRINTED, PER DFILE FORMAT WORD IN E.
;SKIPS IF SAME. CLOBBERS B,C,D. ONE CALL IN "DFILE".
DFDBCM: MOVE B,LPFDB
JUMPE B,[RET] ;NO PREVIOUS FDB, GIVE "DIFFERENT" RET.
MOVE C,FDBCTL(B) ;CONTROL BITS
XOR C,FDBCTL(G)
TLNE C,(FDBEPH) ;CHECK BITS WHICH MATTER
RET
TRNN E,1B30 ;GOING TO PRINT AUTHOR?
JRST .+5 ;NO, SKIP CHECK
HLRZ C,FDBUSE(B) ;AUTHOR
HLRZ D,FDBUSE(G)
CAIE C,0(D) ;SAME?
RET ;NO, GIVE "DIFF" RET
TLNN BB,<3B17>B53 ;PROTECTION: IS IT TO BE LISTED?
JRST .+4 ;NO, CONTINUE COMPARING FIELDS
MOVE C,FDBPRT(B)
CAME C,FDBPRT(G) ;IS IT SAME?
RET ;NO, DIFFERENT
;; TRNN BB,3B20 ;ACCOUNT
;; JRST .+4
;; MOVE C,FDBACT(B)
;; CAME C,FDBACT(G)
;; RET
TRNN BB,1B22 ;SIZE IN PAGES
JRST .+5
HRRZ C,FDBBYV(B)
HRRZ D,FDBBYV(G)
CAME C,D
RET
TRNN BB,1B26 ;BYTES
JRST DFDC10
MOVE C,FDBSIZ(B)
CAME C,FDBSIZ(G)
RET
;ALSO MAKE SURE BYTES ARE SAME SIZE:
LDB C,[POINT 6,FDBBYV(B),11]
LDB D,[POINT 6,FDBBYV(G),11]
CAME C,D
RET
;DATES AND TIMES
DFDC10: MOVE C,FDBCRV(B)
XOR C,FDBCRV(G)
TRNN BB,1B27
TRZ C,-1 ;NOT TIME, MASK IT OUT.
TRNE BB,1B23+1B27 ;CREATE DATE OR TIME TO BE PRINTED?
JUMPN C,[RET] ;YES, TEST FOR SAME
MOVE C,FDBWRT(B)
XOR C,FDBWRT(G)
TRNN BB,1B28
TRZ C,-1
TRNE BB,1B24+1B28
JUMPN C,[RET]
MOVE C,FDBRED(B)
XOR C,FDBRED(G)
TRNN BB,1B29
TRZ C,-1
TRNE BB,1B25+1B29
JUMPN C,[RET]
AOS (P) ;SAME!
RET
;DFNOUT DFILL DFILL9
;DFNOUT: SUBROUTINE FOR DFILE.
;LIKE NOUT EXCEPT ADDS TRAILING SPACES, LIKE "DFILL" (NEXT),
;USING D IN SAME MANNER.
;REQUIRES A, B, C SET UP FOR NOUT, D FOR DFILL.
;CLOBBERS B, C.
DFNOUT: PUSH P,A
MOVE A,CSBUFP ;STRING BUFFER PTR
NOUT ;CONVERT NUMBER TO STRING IN CORE
CALL JERRC ;JSYS ERROR ROUTINE FOR ERR # IN C
SETZ C,
IDPB C,A ;APPEND NULL (NOUT REALLY DOESN'T !)
POP P,A
MOVE B,CSBUFP
;DFILL: SUBROUTINE FOR DFILE.
;OUTPUT STRING B POINTS TO, THEN TYPE SPACES IF NECESSARY TO
;MAKE IT TAKE UP NUMBER OF COLUMNS SPECIFIED IN D.
;DESTINATION IN A; CLOBBERS B,C; RETURNS - # COLS OVERFLOW IN D.
DFILL: HLRZ C,B
CAIN C,-1
HRLI B,<POINT 7,0,-1>B53 ;FILL IN LH BYTE PTR FOR -1
PUSH P,B
SETZ C,
SOUT
POP P,B
ILDB C,B
SOJL D,DFILL9
JUMPN C,.-2
MOVEI B," " ;SPACES NEEDED
TRNN E,1B32 ;E B32 SUPPRESS COLUMNATION
BOUT
SOJGE D,.-2
DFILL9: JUMPE C,[AOJA D,[RET]] ;REMOVE THE NULL TERMINATOR FROM COUNT
ILDB C,B ;COUNT CHARS OVER SPECIFIED MINIMUM
SOJA D,.-2
;OLDTAD OLDTA2
;OLDTAD
;LIST DECTAPE DIRECTORY IN 10/50 FORMAT
;TAKES: OUTDSG: OUTPUT JFN
; A: DEVICE DESIGNATOR (UNIT # IN RH)
;AC USE: A: OUTJFN
; F: POINTER TO BLOCK COUNT BUFFER IN PUSHDOWN
; G: AOBJN POINTER DURING PRINTING
OLDTAD: PUSH P,E
PUSH P,F
;DEVICE DESIGNATOR IS IN A
MOVEI B,DIRBUF ;WHERE TO READ DIR TO
RDDIR ;GET DEVICE DIRECTORY
CALL [ CAIN A,RDDIX1
UERR [ASCIZ /Trouble reading directory,
Maybe DECtape not on "remote"/]
JRST JERR]
;SCAN "SLOTS" PORTION OF DIRECTORY, COUNTING BLOCKS ASSIGNED TO EACH
;FILE, AND FREE BLOCKS (THESE HAVE 0 FILE # BYTE).
HRRZI F,1(P) ;WHERE BLOCK COUNT BLOCK WILL BE
MOVEI B,↑D22
PUSH P,[0] ;ALLOCATE AND CLR 23 WRDS FOR BLK COUNTS
SOJGE B,.-1
MOVE B,[POINT 5,DIRBUF] ;THERE IS ONE 5-BIT BYTE PER BLOCK
MOVEI C,↑D578 ;NUMBER OF BLOCKS
OLDTA2: ILDB D,B ;GET FILE # FOR THIS BLOCK
MOVE E,F
ADD E,D
CAIG D,↑D22 ;IS IT A FILE # OR 0?
;NOTE: DIRECTORY BLOCK (100) AND TENDMP BLOCKS (0, 1, 2)
; HAVE 36 IN THEIR SLOTS.
AOS (E) ;INDEX BLOCK COUNT
SOJG C,OLDTA2
;OLDTA4
;OLDTAD...
;TYPE # FREE BLOCKS
MOVE A,OUTDSG
MOVE B,(F)
MOVEI C,↑D10 ;FREE FORMAT, DECIMAL
NOUT
CALL JERRC
HRROI B,[ASCIZ /. Free blocks left
/]
SETZ C,
SOUT
;TYPE EACH FILE IN THE FORM NNNNNN.EXT BB DD-MMM-YY
HRLZI G,-↑D22 ;NUMBER OF POSSIBLE FILES
OLDTA4: ADDI F,1 ;STEP TO NEXT COUNT WORD IN BLOCK IN PD
SKIPN C,DIRBUF+↑D83(G) ;NAME
JRST OLDTA7 ;NONE, NO FILE FOR THIS FILE #
MOVEI D,6
SETZ B,
LSHC B,6
ADDI B,40 ;CONVERT CHAR TO ASCII
BOUT ;PRINT A CHARACTER OF NAME
SOJG D,.-4
HLLZ C,DIRBUF+↑D105(G) ;EXTENSION
MOVEI B,"." ;SEPARATING CHARACTER: PERIOD,
JUMPN C,.+2
MOVEI B," " ;EXCEPT SPACE IF NO EXTENSION
BOUT
MOVEI D,5 ;3 CHARS OF EXT AND 2 TRAILING SPACES
SETZ B,
LSHC B,6
ADDI B,40
BOUT ;PRINT A CHAR OF EXTENSION
SOJG D,.-4
;NUMBER OF BLOCKS IN FILE: USE 3 COLUMNS, LEADING 0 IF <10,
;TRAILING SPACE IF <100, A LA DEC 10/50 SYSTEM.
MOVE B,(F) ;# BLOCKS
CAIL B,↑D10
JRST .+3
MOVEI B,"0"
BOUT
MOVE B,(F) ;# BLOCKS IN THIS FILE
MOVEI C,↑D10
NOUT
CALL JERRC
MOVE C,(F) ;# BLOCKS ONCE MORE
MOVEI B," "
CAIGE C,↑D100
BOUT ;FILL TO 3 COLS WITH A SPACE
BOUT ;SEPARATING SPACE
;OLDTA7 OLDTA9 LITC5
;OLDTAD...
LDB B,[POINT 12,DIRBUF+↑D105(G),35] ;DATE
MOVEI C,1B35 ;OR IN 3 MORE DATE BITS
TDNE C,DIRBUF+0(G) ;NEW DEC DATE TANDARD
TRO B,1B23
TDNE C,DIRBUF+↑D22(G)
TRO B,1B22
TDNE C,DIRBUF+↑D44(G)
TRO B,1B21
CALL DTADAT ;TYPE DATE IN DECTAPE FORMAT
MOVEI B,CR
BOUT
MOVEI B,LF
BOUT
OLDTA7: AOBJN G,OLDTA4
SUB P,[↑D23,,↑D23]
;STEP PAST ALL JFNS THIS DECTAPE. ADDED 1/71
TLZ Z,F2
HRRZ A,@INIFH1
GNJFN
JRST OLDTA9
TLNN A,70 ;DEV OR DIR CHANGED ?
JRST .-4
TLO Z,F2
OLDTA9: POP P,F
POP P,E
RET
XLIST
LITC5: LIT
LIST
;..PRIN
SUBTTL PDP-10 TENEX EXECUTIVE ** X4CMD.MAC **
;ROUTINES TO DECODE AND EXECUTE SPECIFIC COMMANDS, CONTINUED.
;THIS FILE CONTAINS MORE OF THE LONG AND LITTLE USED COMMANDS,
;SEGREGATED TO MINIMIZE PAGE FAULTS IN NORMAL USE.
;CONTENTS:
; PRINT (NAME) <DIRECTORY NAME> ;PRINTS INFO ASSOC W DIRECTORY
; CREATE (NAME) ... ;CREATES AND MODIFIES
;DIRECTORIES (AND THUS USERS)
;↑E PRINT (NAME) <DIRECTORY NAME> [VERBOSE]
;PRINTS ALL OF THE CHARACTERISTICS ASSOCIATED WITH A DIRECTORY:
; PASSWORD, PRIVILEGES, MODE, SPECIAL RESOURCE INFO, DIRECTORY NUMBER,
; DEFAULT FILE PROT, DIREC PROT, FILE RETENTION SPECS,
; DIRECTORY & USER GROUPS.
;ADD'L KEYWORD "VERBOSE" OR SUBCOMMAND "VERBOSE" CAUSES ALL TO
;BE PRINTED, OTHERWISE ONLY NON-DEFAULT FIELDS.
..PRIN: NOISE <name>
CALL DIRNAM ;INPUT DIRECTORY NAME, GET # AND BITS IN A
ALLOW TALT+TSPC+TEOL+TCOM
ALTYPE ( )
CALL SPRTR ;ANALYZE & CHECK TERMINATOR
JRST [ ;R1: MORE ARG: ALLOW "PRINT NAME VERBOSE"
KEYWD $PRINT
0 ;NULL CAN'T GET HERE
JRST CERR
CALL (KWV)
JRST .+2]
TLO Z,F1 ;R2: COMMA, SAY GET SUBCOMMANDS
;R3: END OF COMMAND
CONFIRM
CALL SUPER
PUSH P,A ;SAVE USER # THRU SUBCOMMANDS
; CALL BREAK2 ;DON'T DO "BREAK" AND "REFUSE"
TLNE Z,F1
SUBCOM $PRINT ;INPUT SUBCOMMANDS
POP P,A
MOVEI A,(A) ;MASK USER #
MOVEI B,1(P) ;BLOCK WILL BE IN PUSHDOWN
HRRO C,CSBUFP ;PUT PASSWORD IN STRING STORAGE AREA
MOVEI D,20 ;ALLOCATE 20-WORD BLOCK IN PD (INCLUDES SPARE
PUSH P,[0] ;...WORDS, BECAUSE ADDITIONS ARE LIKELY)
SOJG D,.-1
GTDIR ;GET ALL THE INFO INTO THAT BLOCK
MOVEI E,(B) ;BLOCK LOCATION
PUSH P,[CMDIN4] ;SET RETURN FOR "DIRPNT" & FALL IN
;DIRPNT PR1 PR2
;DIRPNT
;PRINT DIRECTORY DESCRIPTION FROM GTDIR-FORMAT BLOCK THAT E POINTS TO.
;OMITS DEFAULT VALUES UNLESS BIT F3 IN LH Z IS ON.
;FOR "PRINT" COMMAND AND FOR "LIST" SUBCOMMAND OF "CREATE".
;CLOBBERS B.
DIRPNT: SKIPN A,(E) ;NAME IS NOT IN BLOCK FOR "PRINT".
JRST PR1
TYPE < Name >
CALL CTYPE ;NAME FOR "CREATE" CASE
PRINT EOL
PR1: SKIPN A,1(E)
JRST [ TLNE Z,F3
UTYPE [ASCIZ / No password
/]
JRST PR2]
TLNN Z,F3 ;DON'T PRINT PASSWORD IF NOT VERBOSE
JRST PR2
TYPE < Password >
CALL CTYPE
PRINT EOL
PR2: MOVE B,2(E) ;DISK LIMIT
TLNN Z,F3
CAIE B,750 ;DEFAULT VALUE
ETYPE < Disk limit %2Q
>
;PRIVILEGES
MOVE B,3(E)
TRNN B,1B18
CALL F3NOT
TRZE B,1B18
TYPE < Wheel
>
TRNN B,1B19
CALL F3NOT
TRZE B,1B19
TYPE < Operator
>
TRNN B,1B20
CALL F3NOT
TRZE B,1B20
TYPE < Confidential information access
>
TRNN B,1B21
CALL F3NOT
TRZE B,1B21
TYPE < Maintenance
>
TRNN B,1B22
CALL F3NOT
TRZE B,1B22
TYPE < Netwizard
>
TLNN Z,F3
JUMPE B,.+2 ;NO MORE PRIVILEGES
ETYPE < Other privilege bits %2O
>
;DIRPNT...
;MODE
MOVE B,4(E)
TLNN B,B0
CALL F3NOT
TLZE B,B0
TYPE < Files only
>
;; TLNN B,B1
;; CALL F3NOT
;; TLZE B,B1
;; TYPE < Alphanumeric accounts
;;>
TLNN B,B2
CALL F3NOT
TLZE B,B2
TYPE < Suppress login messages
>
TLNN Z,F3
JUMPE B,.+2 ;TEST FOR ADDITIONAL MODE BITS
ETYPE < Other mode bits %2O
>
SKIPN B,5(E)
TLNE Z,F3
ETYPE < Special resource information %2O
>
SKIPN B,6(E)
JRST [ TLNE Z,F3
UTYPE [ASCIZ / No directory number
/] ;0: NOT ASSIGNED YET ("CREATE" CASE)
JRST .+2]
ETYPE < Directory number %2O
>
MOVE B,7(E)
TLNN Z,F3
CAME B,[500000,,777752] ;DON'T PRINT IF STANDARD
ETYPE < Default file protection %2O
>
MOVE B,10(E)
TLNN Z,F3
CAME B,[500000,,777740]
ETYPE < Directory protection %2O
>
;DIRP11 F3NOT
;DIRPNT...
DIRP11: LDB B,[POINT 4,11(E),35] ;DEFAULT # VERSIONS TO KEEP
TLNN Z,F3
CAIE B,2 ;2 IS DEFAULT
ETYPE < Default # file versions to keep %2Q
>
MOVE B,11(E)
TRZ B,17 ;MASK OFF DEFAULT # VERSIONS
TLNN Z,F3
CAME B,[5B2] ;SEEMS TO BE NORMAL VALUE 11/11/70
ETYPE < Other file retention specifications %2O
>
SKIPN A,12(E)
JRST [ TLNE Z,F3
UTYPE [ASCIZ / Never logged in
/] ;CAN'T USE REG CASE CAUSE %D TYPES CURRENT
;DATE FOR 0
JRST .+2]
ETYPE < Last login %1D %1E
>
SKIPN A,13(E)
TLNE Z,F3
ETYPE < User groups %1U
>
SKIPN A,14(E)
TLNE Z,F3
ETYPE < Directory groups %1U
>
PRINT EOL
RET
;SUBROUTINE TO TYPE " NOT" AND SKIP IF F3 ON
F3NOT: TLNN Z,F3
RET
TYPE < Not>
JRST [ AOS (P)
RET]
;$PRINT ..VERB
;"PRINT" SUBCOMMAND TABLE AND ROUTINES
$PRINT: TABLE
T VERBOSE,ONEWD,..VERB
TEND
..VERB: TLO Z,F3
RET
;SUPER SUPER1 SUPPW
SUPER: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
TYPE < [Superpassword:] >
CALL NOECHO
CALL CSTR
CALL DOECHO
ALLOW TALT+TSPC+TEOL
CALL BUFFF
MOVE B,[POINT 7,SUPPW,-1]
SUPER1: ILDB C,A
ILDB D,B
CAME C,D
JRST CERR
JUMPN C,SUPER1
PRINT EOL
JRST [ POP P,D
POP P,C
POP P,B
POP P,A
RET]
SUPPW: ASCIZ /TELEPHONE/
;.CREAT
;↑E CREATE (NAME) <DIRECTORY NAME> (PASSWORD) --
;EITHER FIELD CAN BE TERMINATED WITH COMMA TO INITIATE SUBCOMMANDS.
;CAN CREATE NEW DIRECTORIES OR MODIFY INFO ASSOCIATED WITH OLD ONES.
;E HOLDS FLAGS AND BLOCK POINTER WHICH WILL BE IN B FOR CRDIR.
;BLOCK IS IN PUSHDOWN.
;FLAGS IN LH E ARE SET ONLY FOR FIELDS EXPLICITLY INPUT BY USER,
; BUT ALL INFO IS IN BLOCK FOR "LIST" SUBCOMMAND.
.CREAT: NOISE <name>
MOVEI E,1(P) ;RH E POINTS TO...
;ALLOCATE CRDIR PARAMETER BLOCK IN PUSHDOWN.
;INITIALIZE MOST WORDS TO THE SYSTEM DEFAULT VALUES SO THAT IN THE
;NEW NAME CASE THE SUBCOMMAND "LIST" WON'T PRINT IF THE VALUE
;HASN'T BEEN EXPLICITLY SPECIFIED.
PUSH P,[0]
PUSH P,[0]
PUSH P,[750] ;DISK LIMIT
PUSH P,[0]
PUSH P,[0]
PUSH P,[0]
PUSH P,[0]
PUSH P,[500000,,777752] ;DEFAULT FILE PROTECTION
PUSH P,[500000,,777740] ;DIRECTORY PROTECTION
PUSH P,[500000,,000002] ;FILE RETENTION SPECS
PUSH P,[0] ;DATE AND TIME OF LAST LOGIN
PUSH P,[0] ;USER GROUP BITS
PUSH P,[0] ;DIRECTORY GROUP BITS
PUSH P,[0]
PUSH P,[0] ;EXTRAS, BECAUSE ADDITIONS ARE LIKELY
PUSH P,[0]
PUSH P,[0]
;CRET1A
;CREATE...
;INPUT NAME AND TYPE [OLD/NEW] AND GET CURRENT INFO FOR OLD.
TLO Z,PUNCF
CALL CSTR
ALLOW TCOM+TALT+TSPC
CALL BUFFF
ALTYPE ( )
PUSH P,A ;PTR TO NAME TEXT FOR USE IN AC1 FOR CRDIR
MOVE B,A
SETZ A,
STDIR
JRST [ U$TYPE [ASCIZ /[New] /]
TLO Z,F2 ;LOCAL FLAG FOR "NEW NAME"
JRST CRET1A]
CALL SCREWUP
PUSH P,A ;SAVE FOR LATER
$TYPE <[Old] >;
; CALL BREAK2 ;DO "BREAK" AND "REFUSE"
POP P,A ;GET DIRECTORY NUMBER
HRRZS A ;FLUSH LH BITS
MOVE B,E
MOVE C,CSBUFP
GTDIR ;GET CURRENT INFO FOR OLD DIR
IBP C
MOVEM C,CSBUFP
;AT THE END OF THE NAME FIELD COMMA MEANS "GO DIRECTLY
;TO SUBCOMMAND INPUT".
;BUT WE CAN'T CALL "SPRTR" HERE BECAUSE IT MIGHT READ AHEAD,
;WHICH IS BAD BECAUSE A NOISE WORD FOLLOWS.
CRET1A: TRNE CBT,TCOM
JRST CRSUB
TRNE CBT,TEOL ;EOL ENDS COMMAND, DON'T INPUT PASSWORD.
JRST CREAT8 ;(ERROR IF NEW, NOP IF OLD, BUT ANYWAY...)
;CREAT3 CREAT8 CREAT9 CRET9A
;CREATE...
;INPUT PASSWORD.
;FOR OLD DIRECTORY, THIS PASSWORD REPLACES OLD ONE - IS THAT GOOD?
NOISE <password>
TLO Z,PUNCF
CALL CSTR
ALTYPE ( )
CALL BUFFF
CAIG CNT,1
JRST CREAT3 ;NULL INPUT MEANS "NO CHANGE"
;CAIN CNT,2
;JRST [ MOVE B,.BFP ;1 CHAR INPUT, IS IT "-" ?
; ILDB B,B
; CAIN B,"-" ;JUST "-" MEANS MAKE IT NULL.
; MOVE A,[POINT 7,[ASCIZ //],-1]
; JRST .+1]
MOVEM A,1(E) ;PASSWD STRING PTR TO PARAMETER BLOCK
TLO E,B1 ;TELL CRDIR TO SET PASSWORD
CREAT3: CALL SPRTR ;TEST TERMINATING CHARACTER(S)
JRST CERR ; R1: MORE ARGS ON THIS LINE. ERROR.
JRST CRSUB ; B2: COMMA, GET SUBCOMMANDS.
; R3: END OF COMMAND.
;CHECK, CONFIRM, EXECUTE
CREAT8: TLZA Z,F1
CREAT9: TLO Z,F1
TLNE Z,F2 ;NEW NAME
TLNE E,B1 ;PASSWORD SPECIFIED?
JRST CRET9A
MOVE A,4(E)
TLNN A,B0
ERROR < Password required for new name unless files-only>
CRET9A: ;CHECK FOR GIVING PRIVILEGES TO FILES-ONLY DIRECTORY & WARN?
CONFIRM
TLNN Z,F1
CALL SUPER
POP P,A ;POINTER TO NAME STRING
TLNE Z,F2
TLOE E,B0
JRST .+2
MOVEM A,(E) ;SUPPLY NAME IF NEW & NOT GIVEN WITH SUBCOMMAND
MOVE B,E ;XWD FLAGS, PARAMETER BLOCK ADDRESS
CRDIR ;CREATE DIRECTORY !
CALL JERR
JRST CMDIN4
;CRSUB
;CREATE...
;SUBCOMMAND LOOP
CRSUB: CONFIRM
CALL SUPER
SUBCOM $CREAT ;INPUT AND DISPATCH ON SUBCOMMANDS
TLO KWV1,CONFRC ;FORCE CONFIRMATION
;NOTE: CONFRC CAN'T BE USED IN NON-SUBCOMMAND CASE
;BECAUSE SPRTR CAN READ CONFIRMING CHARACTER BEFORE "CONF"
;GETS ITS CHANCE TO TYPE "[CONFIRM:]".
JRST CREAT9
;$CREAT ....NO $$$$NO .MAILB
;CREATE...
;SUBCOMMAND DISPATCH TABLE
;FLAG B5 INDICATES "NOT" MAY PRECEDE THE SUBCOMMAND.
$CREAT: TABLE
TE ABORT,ONEWD
;; TE ALPHANUMERIC,B5+LPROK,..ALPH
TE CONFIDENTIAL,B5+LPROK
T DEFAULT
T DIRECTORY,B5+LPROK,..DIRE
T DISK,LPROK,..DISK
TE FILES,B5+LPROK
TE KILL,B5+LPROK+CONMAN
TE LIST,,..LIST
TE MAINTENANCE,B5,.MAINT
T MODE,B5
T NAME
TE NETWIZARD,B5,.NETWI
T NO,,....NO
T NOT,,..NOT
T NUMBER,,...NUM
TE OPERATOR,B5
T PASSWORD
T PRIVILEGES,B5
T PROTECTION,LPROK,...PRO
T RETENTION,B5+LPROK
T SPECIAL,B5+LPROK
TE SUPPRESS,B5+LPROK,.REPEA
T USER,B5+LPROK,.USER
TE WHEEL,B5
TEND
....NO: KEYWD $$$$NO
0 ;NO DEFAULT
JRST CERR
JRST 0(KWV)
$$$$NO: TABLE
TE MAILBOX
TEND
.MAILB: ALLOW TSPC+TALT+TEOL
CONFIRM
TLO E,(1B15) ;"NO MSG FILE" FOR CRDIR
RET
;..NOT .NAME .PASSW
;CREATE...
;"NOT" CAN PRECEDE THOSE SUBCOMMANDS WHICH HAVE B5 SET IN TABLE.
;DISPATCH IS TO SAME ROUTINE BUT WITH "F1" SET TO REVERSE EFFECT.
..NOT: KEYWD $CREAT
0
JRST CERR
TLNN KWV,B5
JRST CERR
MOVE KWV1,KWV
TLO Z,F1
JRST (KWV)
;ROUTINES FOR THE INDIVIDUAL SUBCOMMANDS
;NAME <NAME>. FOR CHANGING A DIRECTORY'S NAME.
.NAME: TLO Z,PUNCF
CALL CSTR
CALL BUFFF
ALLOW TALT+TSPC+TEOL
CONFIRM
JRST NIYE ;NOT IMPLEMENTED AS OF 6/28/70 ←←←←←←←←←←
MOVEM A,(E)
TLO E,B0
RET
;PASSWORD
;CURRENTLY REDUNDANT EXCEPT THAT IT ALLOWS TYPIN IN A FORMAT MORE LIKE
; WHAT "PRINT" PUTS OUT AND ALLOWS GIVING A NULL STRING (USEFUL?).
;LATER I CLAIM PASSWORD FOR OLD DIRECTORY SHOULD BE TESTED FOR
; ACCESS PERMISSION BY NON-WHEELS (AND BE IGNORED FOR WHEELS), AND THIS
; COMMAND BE USED TO CHANGE PASSWORD. ←←←←
.PASSW: TLO Z,PUNCF
CALL CSTR
CALL BUFFF
ALLOW TALT+TSPC+TEOL
CONFIRM
MOVEM A,1(E)
TLO E,B1
RET
;..DISK .NETWI .MAINT .WHEEL .OPERA .CONFI CPRIV .FILES .REPEA CCMODE
;"CREATE" SUBCOMMANDS...
;DISK (STORAGE LIMIT) <DECIMAL>
..DISK: NOISE <storage limit>
CALL DECIN ;DECIMAL INPUT TO A
JRST CERR ;NULL
ALLOW TALT+TEOL+TSPC
CONFIRM
MOVEM A,2(E)
TLO E,B2
RET
;SUBCOMMANDS FOR SPECIFIC PRIVILEGES AND MODES.
;F1 ON AT ENTRY IF PRECEDED BY "NOT".
;AC USE: A: MASK INDICATING BITS TO SET (F1 OFF), OR CLEAR (F1 ON).
.NETWI: SKIPA 1,[1B22]
.MAINT: MOVEI A,1B21
JRST CPRIV
.WHEEL: SKIPA A,[1B18]
.OPERA: MOVEI A,1B19
JRST CPRIV
.CONFI: NOISE <information access>
MOVEI A,1B20
CPRIV: CONFIRM
IORM A,3(E) ;SET BITS IN QUESTION
TLNE Z,F1 ;BUT IF SUBCOMMAND PRECEDED BY "NOT",
ANDCAM A,3(E) ;CLEAR THE BITS.
TLO E,B3
RET
.FILES: NOISE <only>
HRLZI A,B0
JRST CCMODE
;;..ALPH: NOISE <accounts>
;; HRLZI A,B1
;; JRST CCMODE
.REPEA: NOISE <login messages>
HRLZI A,B2
CCMODE: CONFIRM
IORM A,4(E) ;SET BIT
TLNE Z,F1 ;PRECEDED BY "NOT"?
ANDCAM A,4(E) ;YES, CLEAR BIT.
TLO E,B4
RET
;.PRIVI .MODE .SPECI CSPEC ...NUM NUMBE1
;"CREATE" SUBCOMMANDS...
;COMMANDS TO ENTER PRIVILEGES AND MODES IN OCTAL.
;THESE ALLOW ENTERING VALUES WHICH WEREN'T DEFINED WHEN THE CODE FOR
; "CREATE" WAS LAST UPDATED.
;CAN BE PRECEDED BY "NOT" TO TURN OFF RATHER THAN TURN ON THE GIVEN
; BITS.
.PRIVI: CALL OCTCOM ;36-BIT OCTAL INPUT, LH,,RH ETC ACCEPTED.
JRST CERR
;ALLOW TALT+TEOL+TSPC ;"OCTCOM" CHECKS TERMINATOR
JRST CPRIV
.MODE: CALL OCTCOM
JRST CERR
;ALLOW TALT+TEOL+TSPC
JRST CCMODE
;SPECIAL (RESOURCES INFORMATION) <OCTAL>. IRRELEVANT AT PRESENT.
.SPECI: NOISE <resources information>
CALL OCTCOM
JRST CERR
;ALLOW TALT+TSPC+TEOL
CSPEC: CONFIRM ;FUTURE SUBCOMMANDS FOR INDIV BITS CAN COME HERE
IORM A,5(E)
TLNE Z,F1
ANDCAM A,5(E)
TLO E,B5
RET
;NUMBER <OCTAL>. SPECIFIES DIRECTORY NUMBER
...NUM: CALL OCTAL
JRST CERR
ALLOW TALT+TSPC+TEOL
TLNN Z,F2
JRST [ CAME A,6(E)
UERR [ASCIZ / You can't change the number of an old directory/]
JRST NUMBE1]
;CHECK THAT THE NUMBER ISN'T IN USE BY TRYING TO CONVERT IT TO STRING.
MOVE B,A
MOVE A,CSBUFP
DIRST
SKIPA A,B ;NOT IN USE
ERROR <Number already in use>
NUMBE1: CONFIRM
MOVEM A,6(E)
TLO E,B6
RET
;...PRO .DEFAU $DEFAU ....PR ..NUMB
;"CREATE" SUBCOMMANDS...
;PROTECTION (OF DIRECTORY) <OCTAL>. LATER ALSO ALLOW NAMED PROT?
...PRO: NOISE <of directory>
CALL OCTCOM ;OCTAL INPUT SUBR, ACCEPTS LH,,RH ETC.
JRST CERR
;ALLOW TALT+TSPC+TEOL
CONFIRM
MOVEM A,10(E)
TLO E,B8
RET
;DEFAULT (FILE) PROTECTION <OCTAL>
; NUMBER (OF VERSIONS TO KEEP) <DECIMAL>
.DEFAU: NOISE <file>
KEYWD $DEFAU
0
JRST CERR
JRST (KWV)
$DEFAU: TABLE
T NUMBER,LPROK,..NUMB
T PROTECTION,,....PR
TEND
....PR: CALL OCTCOM ;36-BIT OCTAL. OK? ←←←←←←←
JRST CERR
;ALLOW TALT+TSPC+TEOL
CONFIRM
MOVEM A,7(E)
TLO E,B7
RET
..NUMB: NOISE <of versions to keep>
CALL DECIN
JRST CERR
CAIL A,1
CAILE A,15
ERROR <Must be 1-15>
ALLOW TALT+TSPC+TEOL
CONFIRM
DPB A,[POINT 4,11(E),35]
TLO E,B9
RET
;.RETEN .USER ..DIRE BITIN
;"CREATE" SUBCOMMANDS...
;[NOT] RETENTION (SPECIFICATIONS) <OCTAL>
;OR'S IN AND AND'S OUT, APPROPRIATE FOR BITS ONLY.
.RETEN: NOISE <specifications>
CALL OCTCOM
JRST CERR
CONFIRM
IORM A,11(E)
TLNE Z,F1
ANDCAM A,11(E)
TLO E,B9
RET
;[NOT] USER (GROUP) <DECIMAL BIT NUMBER>
;F1 ON IF PRECEDED BY "NOT"
.USER: NOISE <group>
CALL BITIN ;INPUT BIT NUMBER
CONFIRM
IORM A,13(E)
TLNE Z,F1
ANDCAM A,13(E)
TLO E,B11
RET
;[NOT] DIRECTORY (GROUP) <DECIMAL BIT NUMBER>
..DIRE: NOISE <group>
CALL BITIN
CONFIRM
IORM A,14(E)
TLNE Z,F1
ANDCAM A,14(E)
TLO E,B12
RET
;SUBROUTINE TO INPUT DECIMAL BIT NUMBER. RETURNS BIT SET IN A.
;FOR USER AND DIRECTORY GROUP SUBCOMMANDS
BITIN: INHELP <Decimal number 0-35>
TLO Z,BAKFF
CALL DECIN
JRST CERR
CAILE A,↑D35
JRST CERR
MOVN B,A
HRLZI A,B0
LSH A,(B)
RET
;.KILL .ABORT ..LIST $.LIST
;"CREATE" SUBCOMMANDS...
;KILL (THIS DIRECTORY)
.KILL: NOISE <this directory>
CONFIRM
TLO E,B16
TLNE Z,F1
TLZ E,B16 ;"NOT KILL" REVERSES EFFECT.
RET
;ABORT: ABORT THIS CREATE. REDUNDANT FOR ↑C.
.ABORT: MOVEI A,RERET
MOVEM A,CERET
JRST CMDIN4 ;GO GET NEXT EXEC COMMAND
;LIST. PRINTS WHAT "PRINT" WILL PRINT IF THIS "CREATE" IS COMPLETED.
;"LIST VERBOSE" PRINTS AS "PRINT" WITH VERBOSE SUBCOMMAND
..LIST: KEYWD $.LIST
T <>,EOLOK,0
JRST CERR
TLZ Z,F3
CONFIRM
TRNE KWV,F3
TLO Z,F3
TLNN E,B17
JRST DIRPNT ;GO ACT LIKE "PRINT" COMMAND
TYPE < Killed
>
RET
$.LIST: TABLE
T VERBOSE,EOLOK,F3
TEND
;.CYCLE ...DSK $$$DSK
;↑E CYCLE (THE NETWORK)
.CYCLE: NOISE (the network)
CONFIRM
MOVE A,['IMPDRQ']
MOVEI B,1
OPRFN
JRST NIYE
RET
;↑E DISK (PANIC LEVEL FOR) SYSTEM/USERS (IS) <NUMBER OF PAGES>
...DSK: NOISE (panic level for)
KEYWD $$$DSK
0
JRST CERR
MOVE A,['USRSPC'] ;VALUE IS 0 FOR SYSTEM, 1 FOR USERS
TRNN KWV,-1
MOVE A,['SYSSPC']
PUSH P,A
NOISE (is)
CALL DECIN ;INPUT A DECIMAL NUMBER
JRST CERR ;NULL INPUT
SKIPL A ;MAKE SURE IT IS REASONABLE
CAILE A,↑D2000
ERROR <Unreasonable limit>
PUSH P,A
ALLOW TSPC+TALT+TEOL
ALTYPE ( )
CONFIRM
POP P,B ;THE NUMBER
POP P,A ;THE CELL NAME
OPRFN
JRST NIYE ;COME ON CLEMENTS
RET
$$$DSK: TABLE
T SYSTEM,LPROK+WHLUO+OPRUO,0
T USER,LPROK+WHLUO+OPRUO,1
TEND
;.EDDT EDDT3 EDDT4 EDDT5
;↑E EDDT
;TRANSFER CONTROL TO TENEX DDT, GETTING IT IF IT ISN'T ALREADY THERE.
.EDDT: SKIPE DDTORG
JRST EDDT3 ;DDT ALREADY THERE
MOVE B,[POINT 7,[ASCIZ /<SUBSYS>UDDT.SAV/],-1]
CALL $GTJFN ;ENTRY TO "$LPT" SUBR NEAR "DIRECTORY"
HRLI A,B0 ;SAY THIS FORK (JFN IS IN RH A)
GET
CALL RLJFNS
MOVEI A,400000
MOVE B,[EVECL,,EXEC] ;ENTRY VECTOR
SEVEC ;MAKE EV POINT AT EXEC, NOT DDT
;IF WE CAN FIND A SYMBOL TABLE POINTER, PUT IT IN THE DDT.
EDDT3: SKIPN A,..JBSYM ;HAVE WE SAVED SYMBOL TABLE POINTER?
SKIPE A,.JBSYM ;NO, 10/50 SYMBOL TABLE POINTER?
CAIA
JRST EDDT4 ;NO. START DDT.
MOVEM A,@DDTORG+1 ;STORE SYMBOL TABLE POINTER INTO DDT
MOVE B,..JBUSY
SKIPN A ;SOURCE OF .JBUSY MUST BE SAME AS .JBSYM
MOVE B,.JBUSY
MOVEM B,@DDTORG+2
;DEASSIGN ↑C, SO THAT ↑C'S IN DDT WILL GO TO SUPERIOR EXEC.
EDDT4: CALL INFER ;SKIP IF INFERIOR EXEC
JRST EDDT5 ;AT TOP LEVEL LEAVE ↑C ENABLED
MOVEI A,B0 ;THIS FORK
RPCAP ;ENABLED CAPS INTO C
MOVEI A,CTRLC
TLNE C,B0 ;↑C SPEC CAP ENABLED?
DTI ;YES, DEASSIGN ↑C
EDDT5: JRST DDTORG ;ENTER DDT
;.DISAB DISAB1 .ENABL ..LOGO
;DISABLE
;DISABLES PRIVILEGED COMMANDS,
;DISABLES USER (RH) SPEC CAPS IN EXEC AND INFERIOR FORK
; (CAPS POSSIBLE ARE STILL TRANSMITTED, SO INFERIOR CAN USE THEM
; IF IT ENABLES THEM ITSELF)
.DISAB: SETZM PRVENF ;SAY PRIVILEGED COMMANDS OFF
DISAB1: MOVEI A,B0 ;"ENABLE" JOINS HERE
RPCAP
TRZ C,-1
SKIPE PRVENF
HRR C,B
EPCAP ;EXEC'S CAPABILITIES
SKIPG A,FORK
RET ;NO INFERIOR, DONE
RPCAP
TRZ C,-1
SKIPE PRVENF
HRR C,B
EPCAP ;INFERIOR'S CAPS
RET
;ENABLE
;ENABLES OTHER PRIVILEGED COMMANDS IN EXEC, AND ENABLES
;RH (USER) SPECIAL CAPS IN EXEC AND IN INFERIOR FORK, IF THERE IS ONE.
.ENABL: ; CALL BREAK2 ;"BREAK" AND "REFUSE"
SETOM PRVENF ;SAY PRIVILEGED COMMANDS ENABLED
JRST DISAB1
;↑ELOGOUT (JOB #)
..LOGO: PUSH P,A
GJINF
CAMN 3,0(P) ;THIS JOB?
ERROR <If you want to logout this job, use logout>
MOVE 1,['JOBRT ']
CALL $SYSGT ;TABLE OF RUNTIMES
MOVE 1,2
HRL 1,0(P)
GETAB
CALL JERR
JUMPGE 1,.+2 ;REQUESTED JOB EXISTS?
ERROR <That job does not exist>
CONFIRM
POP P,1
LGOUT
CALL JERR
JRST CMDIN4
;.HALT HALT0 HALT2 HALT3 HALT4 HALT7 $HALT ..HLTA ..HLTD $HLTDU ..HLTF ..HLTI ..HLTR ..HLTU
;HALT THE SYSTEM
; NO BITS LEFT IN COMMAND FLAGS FOR A "MAINTENANCE" CAP. BIT
; THUS, PRVCK CAN'T ALLOW "ENABLE", AND THUS, ↑E CANNOT PREFIX THE HALT.
.HALT: CALL SPRTR ;ANALYZE SEPARATOR
JRST CERR ;R1: MORE FOLLOWS
TLO Z,F1 ;R2: SUBCOMMANDS FOLLOW
CONFIRM ;R3: END OF COMMAND
SETZM WHYHLT
MOVEI 1,400000 ;EXEC FORK
RPCAP
TRNN 3,1B18!1B19 ;WHEEL OR OPERATOR MUST BE ENABLED
TRNE 2,1B21 ;MAINT. CANT ENABLE, DO IT FOR HIM
CAIA
JRST CERR
PUSH P,3 ;ENABLED CAPABILITIES
PUSH P,2 ;POSSIBLE CAPABILITIES
; CALL SUPER ;DON'T REQUIRE SUPERPASSWORD FOR HALT
TLNN Z,F1 ;SUBCOMMANDS?
JRST HALT2 ;NO.
HALT0: MOVE 1,['SYSTAT']
CALL $SYSGT
JUMPE B,CERR ;NO SUCH TABLE??
MOVSI 1,27
HRR 1,2
GETAB ;GET ANY CURRENTLY SET DOWN TIME
CALL JERR
MOVEM 1,DOWNTM ;USE AS DEFAULT
MOVSI 1,30
HRR 1,2
GETAB
CALL JERR
MOVEM 1,UPTIME ;DEFAULT UP TIME
SUBCOM $HALT ;DO SUBCOMMANDS TO MODIFY THESE
JRST HALT3 ;GO MAKE ABSOLUTE
HALT2: MOVEI 1,17 ;NO SUBCOM'S. DOWN IN 17 MIN. (TO LET DATACOMPUTER WIND DOWN)
MOVEM 1,DOWNTM
SETZM UPTIME ;WHO KNOWS WHEN IT WILL BE UP AGAIN?
HALT3: MOVE 1,UPTIME
IOR 1,DOWNTM
JUMPE 1,HALT4 ;BOTH 0 ==> RETRACT
SKIPN 2,DOWNTM ;SKIP IF ABSOLUTE OR REL.
MOVEI 2,5 ;NOT SET. DEFAULT TO 5 MIN.
GTAD ;WHAT TO ADD REL. TO
TLNE 2,-1 ;DOWNTM IS ABS?
JRST .+3 ;YES
CALL TIMPMN ;ABS IN 1 PLUS MINS IN 2
MOVEM 1,DOWNTM ;THAT'S THE DOWN TIME
SKIPE 2,UPTIME ;IF UPTIME IS NOT SET...
TLNE 2,-1 ;OR IS ABSOLUTE,
JRST HALT4 ;THEN TAKE AS IS.
MOVE 1,DOWNTM ;OTHERWISE IT IS RELATIVE TO DOWN TIME
CALL TIMPMN ;TIME IN 1 PLUS MINUTES IN 2
MOVEM 1,UPTIME
HALT4: POP P,3 ;CAPABILITIES POSSIBLE
MOVEI 1,CTRLC ;↑C TERMINAL CODE
TLNE 3,(1B0) ;↑C CAP. ENABLED?
DTI ;YES, DEASSIGN IT
MOVEI 1,400000 ;THIS FORK
EPCAP
HALT7: MOVE 1,DOWNTM
MOVE 2,UPTIME
MOVE 3,WHYHLT ;REASON FOR HALTING
HSYS
TLOA Z,F1 ;REMEMBER HSYS FAILED
TLZ Z,F1 ;HSYS WAS OK
MOVEI 1,400000
POP P,3 ;RESTORE CAPS. AS THEY WERE AT ENTRY
EPCAP
MOVE 1,[CTRLC,,1] ;↑C ON CHAN 1
TLNE 3,(1B0) ;IF SPECIAL CAP IS ENABLED
ATI
TLNE Z,F1 ;DID HSYS FAIL?
JRST CERR ;YES
RET ;NO
$HALT: TABLE
T AT,LPROK,..HLTA
T DUE,LPROK,..HLTD
T FOR,LPROK,..HLTF
T IN,LPROK,..HLTI
T RETRACT,ONEWD,..HLTR
T UNTIL,LPROK,..HLTU
TEND
..HLTA: NOISE <date and time>
CALL DATEIN
MOVEM A,DOWNTM
RET
..HLTD: NOISE <to reason>
KEYWD $HLTDU
0
JRST CERR
ALLOW TALT+TEOL
ALTYPE ( )
CONFIRM
HRRZM KWV,WHYHLT
RET
$HLTDU: TABLE
TE EMERGENCY,,8
TE HARDWARE,,6
TE PM,,5
TE PREVENTIVE-MAINTENANCE,,5
TE SOFTWARE,,7
TEND
..HLTF: NOISE <number of minutes>
CALL DECIN
JRST CERR
JUMPL A,CERR
ALLOW TALT+TSPC+TEOL
CONFIRM
HRRZM A,UPTIME ;A RELATIVE TIME
RET
..HLTI: NOISE <number of minutes>
CALL DECIN
JRST CERR
JUMPLE A,CERR
ALLOW TALT+TSPC+TEOL
CONFIRM
HRRZM A,DOWNTM ;A RELATIVE TIME
RET
..HLTR: NOISE <any pending shutdown request>
SETZM DOWNTM ;NO KNOWN DOWN TIME
SETZM UPTIME ;OR UPTIME
SETZM WHYHLT ;OR REASON
RET
..HLTU: NOISE <date and time>
CALL DATEIN
ALLOW TALT!TEOL
CONFIRM
MOVEM A,UPTIME
RET
;TIMPMN TIMPSC
;ADD THE MINUTES IN 2 TO THE TAD IN 1
TIMPMN: IMULI 2,↑D60 ;MAKE IT SECONDS
;ADD THE SECONDS IN 2 TO THE TAD IN 1
TIMPSC: ADDI 2,0(1) ;ADD IN SECONDS FROM TAD
IDIVI 2,↑D<60*60*24> ;NUMBER OF SECONDS IN A DAY
MOVSS 2 ;0 FOR TODAY, 1,,0 FOR TOMORROW, ETC
ADD 1,2 ;BUMP DAY
HRR 1,3 ;INSERT SECONDS
RET
;.INITI $INITI
;;↑E INITIALIZED ACCOUNTS/HOSTS
REPEAT 0,<
.INITI: KEYWD $INITI
0
JRST CERR
MOVE A,['ACTINI'] ;VALUE IS 0 FOR ACCOUNTS, 1 FOR HOSTS
TRNE KWV,-1
MOVE A,['HSTINI']
CONFIRM
OPRFN
JRST NIYE
RET
$INITI: TABLE
TE ACCOUNTS,WHLUO+OPRUO,0
TE HOSTS,WHLUO+OPRUO,1
TEND
>
;.KFACT .LOAD .NETWO $NETWO
;↑E K (FACTOR IS) <FLOATING NUMBER>
REPEAT 0,<
.KFACT: NOISE (factor is)
CALL FPIN ;INPUT A FLOATING POINT NUMBER
SKIPL A
CAMLE A,[1.0]
JRST CERR
ALLOW TSPC!TALT!TEOL
CONFIRM
MOVE B,A
MOVE A,['KFACT ']
OPRFN
CALL JERR
RET
>
;↑E LOAD (EDDT)
.LOAD: NOISE (EDDT)
CONFIRM
MOVE A,['DDTRCL']
OPRFN
CALL JERR
RET
;↑E NETWORK OFF/ON
.NETWO: KEYWD $NETWO
0
JRST CERR
CONFIRM
HRRE B,KWV
MOVE A,['NETON ']
OPRFN
CALL JERR
RET
$NETWO: TABLE
TE OFF,,0
TE ON,,-1
TEND
;.OFFLI .ONLIN .ONLI1
; ↑E OFFLINE (CORE FROM PAGE) ... (THROUGH PAGE) ...
; ↑E ONLINE (CORE FROM PAGE) ... (THROUGH PAGE) ...
.OFFLI: TLZA Z,F1 ;REMEMBER WHICH COMMAND
.ONLIN: TLO Z,F1
NOISE (core from page)
.ONLI1: CALL OCTAL
JRST [ ALLOW TALT ;NO NUMBER, THINK ABOUT DEFAULT
TLNN Z,F1 ;"OFFLINE" HAS NO DEFAULT
JRST [ CALL DING
JRST .ONLI1]
MOVEI A,0
U$TYPE [ASCIZ /0 /]
JRST .+1]
ALLOW TSPC+TALT+TLPR
CAILE A,1237 ;MAKE SURE IT'S A GOOD PAGE NUMBER
JRST CERR
PUSH P,A ;SAVE FOR LATER
NOISE (through page)
CALL OCTAL
JRST [ ALLOW TALT
MOVEI A,1237
U$TYPE [ASCIZ /1237 /]
JRST .+1]
ALLOW TSPC+TALT+TEOL
CAIG A,1237 ;CHECK FOR REASONABLE PAGE NUMBER
CAMGE A,0(P) ;AND ORDER
JRST CERR
POP P,B ;FIRST PAGE
MOVE C,A ;LAST PAGE
CONFIRM
TLNN Z,F1 ;WHICH COMMAND
SKIPA A,['MKPGSU'] ;"OFFLINE"
MOVE A,['MKPGSA'] ;"ONLINE"
OPRFN
CALL JERR
RET
;..PAUS .PERMI .PROCE .PROHI
;↑E PAUSE
..PAUS: NOISE (at BUGCHKs)
CONFIRM
MOVEI B,1
MOVE A,['DCHKSW']
OPRFN
CALL JERR
RET
;↑E PERMIT
.PERMI: NOISE (logins)
CONFIRM
MOVE A,['ENTFLG']
SETO B,
OPRFN
CALL JERR
RET
;↑E PROCEED
.PROCE: NOISE (at bugchks)
CONFIRM
MOVE A,['DCHKSW']
SETZ B,
OPRFN
CALL JERR
RET
;↑E PROHIBIT
.PROHI: NOISE (logins)
CONFIRM
MOVE A,['ENTFLG']
SETZ B,
OPRFN
CALL JERR
RET
;.SYSTE $SYSTE
;↑E SYSTEM (IS) ...
.SYSTE: NOISE (is)
KEYWD $SYSTE
0
JRST CERR
CONFIRM
MOVE A,['DBUGSW']
MOVEI B,0(KWV)
OPRFN
CALL JERR
RET
$SYSTE: TABLE
TE ATTENDED,,1
TE DEGUGGABLE,,2
TE UNATTENDED,,0
TEND
;.SET INDT CHKDAT CHKDA4 CHKDA8 CHKDA9
;↑E SET (DATE AND TIME)
.SET: NOISE <date and time>
;FALL INTO "INDT" WHICH DOES THE REST
;SUBROUTINE TO INPUT AND SET DATE AND TIME
;FOR MAIN LOOP AND ↑E SET COMMAND.
INDT: CALL DATEIN ;INPUT DATE AND TIME
PUSH P,1
CALL CHKDAT ;SKIP IF IT LOOKS OK
JRST [ TYPE < Please reconfirm: >
MOVE 1,COJFN ;PRIMARY OUTPUT JFN
MOVE 2,0(P) ;DATE TYPED IN
SETOM 3 ;VERBOSE FORMAT
ODTIM
TLO KWV1,CONMAN
CONFIRM
JRST .+1]
POP P,A
STAD ;SET TIME AND DATE
CALL [ CAIN A,STADX1 ;SPEC CAP NOT ENABLED ERROR?
RET ;YES. GO QUIETLY AWAY
JRST JERR]
RET
;CHECK TYPED IN TIME TO BESURE IT IS OK FOR STAD
; CURRENTLY THIS MEANS WITHIN 11 HRS. AFTER LAST FACT FILE WRITE
CHKDAT: PUSH P,1
INTOFF ;BE SURE JFN WILL GET STACKED
MOVSI 1,(1B2!1B17)
HRROI 2,[ASCIZ /<OPERATIONS>OPERATIONS.LOG/] ;(STANDARD IS <ACCOUNTS>FACT. )
GTJFN
JRST [ INTON ;CAN'T GET JFN, FORCE RECONFIRMATION
JRST CHKDA9] ;NO-SKIP RETURN
MOVE 2,JBUFP ;JFN STACK PTR
PUSH 2,1 ;SAVE FOR RELEASE AT ↑C OR ERROR
MOVEM 2,JBUFP
INTON
MOVE 1,0(2) ;GET THE JFN BACK
MOVE 2,[1,,FDBWRT]
MOVEI 3,3
CALL $GTFDB ;DON'T SKIP IF ACCESS LACKING
JRST CHKDA8
CHKDA4: CAML 3,0(P) ;DATE TYPED MUST BE AFTER FILE WRITE
JRST CHKDA8 ;NOT SO
MOVE 1,3
MOVEI 2,↑D<11*60*60> ;TIME LIMIT = 11 HRS.
CALL TIMPSC ;GTAD IN 1 PLUS SECONDS IN 2, TO 1
CAML 1,0(P) ;11HRS AFTER FILE WRT BEFORE INPUT ?
AOS -1(P) ;DATE LOOKS GOOD, SKIP
CHKDA8: CALL RLJFNS
CHKDA9: POP P,1
RET
;.TRAPS $TRAPS ..UNLO
REPEAT 0,<
; ↑E TRAPS OFF/ON
.TRAPS: NOISE (of JSYS's)
KEYWD $TRAPS
0
JRST CERR
CONFIRM
MOVE A,['JTRPON']
HRRE B,KWV
OPRFN
CALL JERR
RET
$TRAPS: TABLE
TE OFF,,0
TE ON,,-1
TEND
>
;↑E UNLOAD EDDT
..UNLO: NOISE (EDDT)
CONFIRM
MOVE A,['DDTFSH']
OPRFN
CALL JERR
RET
LIT
;.NETLO NETLO0 NETLO2
SUBTTL ** X5CMD.MAC **
;NETLOAD
IFN DST10X,<
;PRINTS THE 5 MIN. LOAD AVERAGES FROM
; ALL COOPERATING TENEX SITES. THIS INFORMATION IS KEPT IN
; THE FILE <SYSTEM>RSYSTAT.;1 PAGE 0.
;WORD-0 OF THE PAGE RSSER VERSION # OR -1 IF BEING UPDATED
;WORD-1 IS N,,PTR WHERE N IS THE LENGTH OF THE BLOCK ASSOCIATED
; WITH EACH SITE, AND PTR IS THE RELATIVE ADDRESS OF THE FIRST
; SITE BLOCK.
;WORD-5 IS GTAD FORMAT TIME OF LAST UPDATE
;WORD-10 (IF PTR .GE. 10) HAS SIZE,,OFFSET OF SITE INFO
;EACH SITE BLOCK HAS THE FOLLOWING THINGS OF INTEREST IN IT
; (OFFSET IS 6 FOR OLD FORMAT (N .LE. 10):
;WORD-0: SITE NUMBER
;WORD-4: -1 IF DATA IS GOOD FOR THIS SITE
;WORD-(0 + OFFSET): AMOUNT OF USER CORE (IF N .GT. 10)
;WORD-(1 + OFFSET): 1 MIN. LOAD AV.
;WORD-(2 + OFFSET): 5 MIN. LOAD AV.
;WORD-(3 + OFFSET): 15 MIN. LOAD AV.
;WORD-(4 + OFFSET): NUMBER OF USERS
;WORD-(5 + OFFSET): NUMBER OF DISK PAGES IN USE
;WORD-(6 + OFFSET): NUMBER OF FREE DISK PAGES
.NETLO: HRROI 2,[ASCIZ /<SYSTEM>RSYSTAT.;1/]
CALL TRYGTJ ;ASSIGN AND STACK JFN
NETLO0: ERROR <Network load statistics not available>
MOVE 2,[44B5+1B19+1B25] ;READ, THAWED
OPENF
JRST NETLO0 ;GO TYPE ERROR
HRLZS 1 ;FROM FILE PAGE 0
MOVE 2,[400000,,<NSBUF/1000>] ;TO ADDRESS SPACE
MOVSI 3,(1B2!1B9) ;READ, COPY ON WRITE
PMAP
MOVES NSBUF ;MAKE PAGE PRIVATE (STROBE DATA)
SKIPGE NSBUF+0 ;CHECK VERSION NUMBER
UERR [ASCIZ / Data base being updated/]
; INSPECT TIME OF LAST UPDATE TO SEE IF DATA IS VALID
NETLO2: GTAD ;NOW
SUB 1,NSBUF+5 ;MINUS LAST UPDATE
TRNE 1,1B18 ;SECONDS WRAPPED AROUND?
ADD 1,[-1,,↑D<24*60*60>];YES, BORROW A DAY
SKIPE NSBUF+1 ;PARANOIA
CAIL 1,↑D<5*60> ;UPDATED WITHIN LAST 5 MINUTES?
UERR [ASCIZ / Server dead/]
;NETLO4 NETL41 NETL42 NETL43 NETL44 NETLO5 NETL55 NETL56 NETL57 NETLO6 NETL69 NETLO9 NETLOX
NETLO4: HRRZ 1,NSBUF+1 ;CHECK PTR
CAILE 1,10 ;TEST FOR NEW FORMAT
TLOA Z,F1 ;YES, REMEMBER THAT
TLZ Z,F1 ;NO
NETL41: TLNE Z,F1
JRST NETL43
NETL42: TYPE < Sits Load Users
>
JRST NETL44
NETL43: TYPE < Site Load Users Disk Av.
>
NETL44: HRRZ D,NSBUF+1 ;PTR TO FIRST SITE BLOCK
MOVEI E,6 ;OFFSET FOR OLD FILES
TLNE Z,F1 ;NEW FORMAT?
HRRZ E,NSBUF+10 ;YES, USE IT
ADDI E,0(D) ;D AND E DIFFER BY OFFSET
NETLO5: MOVE 1,COJFN
SKIPN NSBUF(D) ;END OF ALL SITES?
JRST NETLOX ;YES, DONE.
MOVE 3,NSBUF+4(D)
CAME 3,[-1] ;DO WE HAVE GOOD DATA FOR THIS ONE?
JRST NETLO9 ;NO SKIP IT
MOVEI 2," "
BOUT
MOVE 2,NSBUF+0(D) ;GET BACK SITE NUMBER
MOVEI 3,↑D10
CVHST ;PRINT HOST NAME, OR ...
NOUT ;NUMBER IF THAT FAILS
JFCL
;BE APPROPRIATELY SUSPICIOUS OF THE FILE FORMAT
NETL55: PRINT TAB
RFPOS
MOVEI 2,0(2)
CAIG 2,↑D10 ;WAS FIRST TAB ENOUGH?
PRINT TAB ;NO
SKIPGE 2,NSBUF+2(E) ;THAT SITE'S 5 MIN. LOAD AV
JRST NETL57 ;MUST BE POSITIVE
MOVE 3,2
TLZN 3,(1B1)
JRST NETL56 ;LOAD LESS THAN 0.5 -- OK
TLNN 3,370000 ;EXPONENT TOO BIG?
TLNN 3,400 ;NOT NORMALIZED FLOATING NUMBER?
JRST NETL57 ;YES.
NETL56: MOVE 3,[1B4+1B6+2B23+2B29] ;FORCE, WITH ".", 2 BEFORE AND AFTER
FLOUT
NETL57: TYPE < ? >
TYPE < >
MOVE 3,[1B2+3B17+12] ;RIGHT JUST, 3 COLS, DECIMAL
SKIPL 2,NSBUF+4(E) ;NUMBER OF USERS ON THAT SYSTEM
NOUT
TYPE < ?>
NETLO6: TLNN Z,F1
JRST NETL69 ;OLD FORMAT
MOVE 2,NSBUF+6(E) ;DISK SPACE AVAILABLE
MOVE 3,[1B2!11B17!↑D10] ;RIGHT JUSTIFIED, 9 COLS, DECIMAL
NOUT
CALL JERRC
NETL69: PRINT EOL
NETLO9: HLRZ 1,NSBUF+1 ;SITE BLOCK LENGTH
ADDI D,0(1) ;BUMP TO NEXT BLOCK
ADDI E,0(1)
JRST NETLO5 ;AND DO IT
NETLOX: SETOM 1
MOVE 2,[400000,,<NSBUF/1000>]
PMAP ;FLUSH PAGE
PRINT EOL
JRST RLJFNS ;GO RELEASE THE JFN
>;IFN DST10X
;READY READY4 READY2 READY3
;SUBROUTINES TO PRINT READY CHARACTER: "@" NORMALLY,
; "!" IF PRIVILEGED COMMANDS ENABLED.
READY: PUSH P,A
PUSH P,B
MOVE A,COJFN
RFPOS
TRNN B,-1 ;AT LEFT MARGIN?
JRST READY4 ;YES
MOVEI B,CR ;NO, TYPE CRLF FIRST
BOUT
MOVEI B,LF
BOUT
READY4: MOVEI B,"↑"
SKIPLE XFORK
BOUT
CALL INFER
JRST READY3
MOVEI B,"←"
MOVN C,STRTAC ;COUNT OF LEVELS DOWN
BOUT
AOJL C,.-1 ;ONE "←" FOR EACH LEVEL
JRST READY3
READY2: CALL READY ;PRINT 2 READY CHRS FOR SUBCOMMANDS
PUSH P,A ;PRINT ONE READY CHARACTER
PUSH P,B
MOVE A,COJFN
READY3: MOVEI B,"@"
SKIPE PRVENF
MOVEI B,"!"
BOUT
POP P,B
POP P,A
RET
;%KEYW
;KEYWORD INPUT AND LOOKUP UUO SERVICE ROUTINE ("KEYWD" UUO)
SUBTTL ** XSUBRS.MAC **
;DOES EDITING, TABLE LOOKUP, RECOGNITION.
;DEFAULTS: ON NULL INPUT, OR WITHOUT INPUT IF LAST TERMINATOR = EOL,
; OR IF DASH AND TERMINATOR INPUT
;
;USAGE:
; SET FLAGS BAKFF,PUNCF,NEOLF IF DESIRED
; (SEE COMMENTS IN FILE XDEF.MAC)
; KEYWD TABLE
; 0 OR XWD [VALUE],[ASCIZ @TEXT@] FOR DEFAULT VALUE
; R1: NOT IN TABLE, OR NULL INPUT WITH NO DEFAULT IN CALL.
; "BAKFF" IS SET SO SAME INPUT IS USED ON NEXT CALL.
; R2: FOUND, "VALUE" IN "KWV"
; ON EITHER RETURN, TERMINATOR IS IN "TRM" AND "CHR",
; DESCRIPTIVE BITS FOR TERMINATOR IN "CBT"
; TEXT IS APPENDED TO "CBUF", "BFP" IS END BYTE PTR, ".BFP", BEG.
; PUNCF AND NEOLF ARE CLEARED
; EOLNEF SET IF AN EOL WAS INPUT AND WAS NOT ECHOED
;
;GOES DIRECTLY TO "CERR" ON BAD CHARACTER, TOO LONG, AMBIGUOUS, ETC
;ACCEPTABLE CHARACTERS ARE LETTERS AND DIGITS ONLY UNLESS "PUNCF" ON.
; ("-" ALSO ACCEPTED MERELY TO SIMPLIFY CODING DEFAULT ON "-" IN INPUT.)
;TERMINATORS: ALT MODE, SPACE, COMMA IF "COMOK" ON IN VALUE (OW←CERR),
;EOL OR SEMICOLON IF "EOLOK" ON IN VALUE,
;LEFT PAREN IF "LPROK" ON IN VALUE,
;"<" IF "LANOK" ON IN VALUE (SPECIAL TREATMENT DESCRIBED BELOW).
;
;DEFAULTING: ON ALT MODE DEFAULT TEXT IS TYPED; GOOD RETURN IS GIVEN
; AS THOUGH DEFAULT TEXT HAD BEEN INPUT.
;
;BACKUP: IF "BAKFF" IS SET AT ENTRY, PREVIOUS INPUT STRING IS RE-USED.
;
;GLITCH NOTE: IF LAST TERMINATOR IS EOL OR SEMICOLON,
; DEFAULTS WITHOUT INPUT, SO OPTIONAL FIELDS
; AT END OF COMMAND ARE AUTOMATICALLY DEFAULTED.
; BUT THIS DOESN'T HAPPED IF BAKFF IS SET (EXTERNALLY). ALSO THIS
; MEANS "TEOL" BIT IN AC "CBT" MUST BE OFF
; AT FIRST CALL ON A NEW LINE.
;
;TABLE FORM:
; TABLE: NUMBER OF ENTRIES
; XWD [VALUE],[ASCIZ @TEXT@] FOR EACH ENTRY, ALPH ORDER
; ;"VALUE" HAS BITS IN LEFT HALF (SOME INTERPRETED HERE),
; ; USUALLY DISPATCH ADDRESS IN RIGHT HALF
;%KEYW CWRD2 CWRD3 CWRD3A
%KEYW: PUSH P,D
PUSH P,C
PUSH P,B
PUSH P,A
PUSH P,40
TLNE Z,BAKFF
JRST .+3
TRNE CBT,TEOL ;LAST TERMINATOR=EOL OR SEMICOLON?
JRST [ SKIPN D,@-5(P) ;YES, DEFAULT ARGUMENT GIVEN?
JRST .+1
JRST CWRD2] ;YES, GO DEFAULT WITHOUT INPUTTING
;INPUT. "INHELP" MACRO INPUTS A FIELD (WITH CSTR), DOING EDITING &
;RE-USING PREVIOUS INPUT IF "BAKFF" ON, AND TYPES MESSAGE IF "?" INPUT.
;%Z TYPES ALL KEYWORDS IN TABLE. CSTR HANDLES NEOLF AND EOLNEF.
MOVE A,(P) ;TABLE ADDRES FOR %Z
INHELP <One of the following:
%1Z>;
;CHECK THAT FIELD TERMINATOR IS LEGAL
ALLOW TEOL+TSPC+TALT+TCOM+TLPR+TLAN
;LEFT-JUSTIFY AND ZERO-FILL THE STRING IN CWBUF BECAUSE "FSYM"
; REQUIRES IT THAT WAY.
SETZM CWBUF
SETZM CWBUF+1
SETZM CWBUF+2
SETZM CWBUF+3
CAILE CNT,↑D18 ;WILL IT FIT 4-WORD BUFFER
ERROR <Word too long>
MOVE B,.BFP ;BEGINNING OF STRING
MOVEI C,-1(CNT) ;REDUCE COUNT BY ONE TO OMIT TERMINATOR
JUMPG C,CWRD3 ;JUMP IF NON-NULL INPUT
SKIPN D,@-5(P) ;PICK UP WORD AFTER CALL
JRST CWRD8 ;NO DEFAULT SPECIFIED IN CALL
CWRD2: HLRZ C,D ;PRETEND WE RETURNED FROM FSYM: [VALUE],
HRLI D,<POINT 7,0,-1>B53 ;.. BYTE POINTER TO TEXT
JRST CWRD4 ;USE CODE FOR "UNIQUE SUBSET" MATCH
CWRD3: MOVE D,[POINT 7,CWBUF,-1]
CWRD3A: ILDB A,B ;COPY LOOP
CAIL A,141 ;ASCII LOWER CASE A
CAILE A,172 ;ASCII LOWER CASE Z
JRST .+2 ;NOT A LOWER CASE LETTER
SUBI A,40 ;CONVERT LOWER CASE TO UPPER
IDPB A,D
SOJG C,CWRD3A
CAIN CNT,2 ;CHECK FOR "-": 1 CHAR+TERMINATOR?
JRST [ CAIN A,"-" ;YES, WAS THAT CHARACTER "-"?
SKIPN D,@-5(P) ;YES, PICK UP WORD AFTER CALL
JRST .+1 ;NOT "-" OR NO DEFAULT PTR AFTER CALL
HLRZ C,D ;PRETEND WE GOT EXACT MATCH RETURN...
JRST CWRD5] ;...FROM FSYM: [VALUE] IN C
;CWRD4 CWRD5 CWRD6
;%KEYW...
;LOOK IT UP
MOVE A,(P) ;POINTER THAT CAME IN 40
MOVEI B,CWBUF ;LOCATION OF TEXT
CALL FSYM ;SEARCH TABLE (A) FOR TEXT (B). 4 RETURNS.
;R1: NO MATCH AT ALL. GIVE BAD RETURN WITH "BAKFF" SET.
JRST CWRD8
;R2: AMBIGUOUS PARTIAL MATCH. ALLOW MORE INPUT IF ALT MODE.
JRST [CAIE CHR,ALTM
JRST CERR ;TERMINATOR NOT ALT MODE
CALL DING ;RING BELL, STOP NON-INTERACTIVE JOB,
;CLEAR TTY INPUT BUFFER.
CALL UBP ;GET RID OF ALT MODE IN BUFFER
JRST MORE] ;GET MORE INPUT, RETN WHERE CSTR DID
;R3: UNIQUE PARTIAL MATCH. TYPE REST ON ALT MODE.
;ALSO, DEFAULT COMES HERE W TEXT PTR TO ENTIRE TEXT
CWRD4: JRST [CAIE CHR,ALTM
JRST .+1 ;NOT ALT MODE, OK AS IS.
MOVE B,(C) ;USED BY PRVCK
CALL PRVCK ;CHECK PRIVILEGE BEFORE PRINTING REST
JRST CERR ;PRIVILEGE NEEDED & LACKING
CALL UBP ;BACK UP
TLO Z,STCF ;SAY "STORE PRINTED CHARACTERS"
MOVE A,D ;POINTER TO REST RETURNED BY "FSYM"
CALL CTYPE ;PRINT AND ALSO STORE STRING
TLZ Z,STCF
JRST CWRD6] ;PRIVILEGES ARE ALREADY CHECKED.
;R4: PERFECT MATCH.
;ALSO, "-" INPUT DEFAULT COMES HERE
;CHECK WHETHER THE USER HAS SPECIAL PRIVILEGES REQUIRED
; BY CERTAIN KEYWORDS (MOST DON'T REQUIRE ANY).
CWRD5: MOVE B,(C) ;VALUE WORD INCLUDES PRIVILEGE FLAGS
CALL PRVCK ;SKIP IF USER HAS PRIVS, IF ANY REQUIRED
JRST CERR ;HE LACKS PRIVILEGES.
CWRD6: MOVE KWV,(C) ;VALUE WORD. "FSYM" RETURNED PTR TO IT.
TLNN KWV,NSPALT ;THIS BIT SAYS DON'T...
ALTYPE ( ) ;TYPE SPACE AFTER WORD TERMINATED WITH ALT MODE.
;CWRD8
;%KEYW...
;WORD HAS BEEN FOUND IN TABLE.
;CHECK CERTAIN TERMINATORS VS CERTAIN FLAGS.
TRNE CBT,TCOM
JRST [ TLNN KWV,COMOK
JRST CERR
JRST .+1]
TRNE CBT,TLPR
JRST [ TLNN KWV,LPROK
JRST CERR
JRST .+1]
TRNE CBT,TEOL
JRST [ TLNN KWV,EOLOK+ONEWD ;ONEWD IMPLIES EOLOK
JRST CERR
JRST .+1]
TRNE CBT,TLAN
JRST [ TLNN KWV,LANOK
JRST CERR
;SPECIAL HANDLING OF "<" TERMINATOR, VALID ONLY IN
;CONTEXTS WHERE IT IS REALLY THE BEGINNING OF THE
;THE NEXT FIELD: SET UP BAKFF, CNT, .BFP SO
;THAT NEXT CSTR WILL RETURN 1-CHAR STRING "<".
;VALUES OF CNT AND .BFP FOR CURRENT KEYWORD ARE LOST.
MOVE .BFP,BFP
CALL UBP ;UNINCREMENTS BFP
EXCH .BFP,BFP
MOVEI CNT,1
TLO Z,BAKFF
JRST .+1]
;EXIT
AOSA -5(P) ;SKIP
CWRD8: TLO Z,BAKFF ;ON BAD RETURN SET "BACK UP FIELD" FLAG
AOS -5(P) ;GET PAST DEFAULT ARGUMENT WORD
POP P,40
POP P,A
POP P,B
POP P,C
POP P,D
RET
;PRVCK PRVCK8
;PRVCK
;SUBROUTINE TO CHECK SPECIAL CAPABILITIES THIS USER HAS AGAINST THOSE
; REQUIRED AS INDICATED BY BITS IN B, GENERALLY FROM
; A KEYWORD TABLE.
;SKIPS UNLESS SPEC CAP(S) ARE REQUIRED BUT USER HAS NONE OF THEM.
;USES: FORK COMMAND (XCMD1.MAC), %KEYWD (JUST ABOVE).
PRVCK: TLNN B,WHLUO+OPRUO+ERRUO+WOEPUO
JRST [ AOS (P) ;NO SPEC CAP REQUIRED, QUICK EXIT.
RET]
PUSH P,A ;COMMAND REQUIRES SPECIAL CAPABILITIES
PUSH P,B
PUSH P,C
PUSH P,D
MOVE D,B
MOVEI A,B0
RPCAP ;READ CAPABILITIES ENABLED FOR THIS PROCESS
TLNE D,WOEPUO ;WOEPUO REQUIRES WHEEL, OPER, OR CONF INF ACCESS
TRNN B,1B18+1B19+1B20 ;...POSSIBLE BUT NOT NECESSARILY
JRST .+2 ;...ENABLED.
JRST PRVCK8
TLNE D,WHLUO
TRNN C,1B18
JRST .+2
JRST PRVCK8 ;WHEEL COMMAND AND "ENABLE"D WHEEL USER
TLNE D,OPRUO
TRNN C,1B19
JRST .+2
JRST PRVCK8 ;OPERATOR COMMAND AND "ENABLE"D OPERATOR USER
TLNE D,ERRUO
TRNN C,1B20 ;TEST "CONFIDENTAIL INFORMATION ACCESS" CAP
JRST .+2
PRVCK8: AOS -4(P)
POP P,D
POP P,C
POP P,B
POP P,A
RET
;FSYM - SYMBOL TABLE LOOKUP SUBROUTINE USED IN %KEYW (PRECEDING)
;SYMBOL TABLE LOOKUP SUBROUTINE
;TAKES: A: POINTER TO TABLE
; B: WORD POINTER TO INPUT STRING TO SEARCH FOR. MUST BE LEFT
; ADJUSTED, NULL TERMINATED, LAST WD FILLED W NULLS.
; CALL FSYM
;RETURNS: +1: NO MATCH AT ALL
; +2: INPUT IS AMBIGUOUS -- IT IS INITIAL SUBSTRING OF MORE
; THAN ONE TABLE ENTRY'S TEXT
; +3: INPUT IS INITIAL SUBSTRING OF A UNIQUE TABLE ENTRY
; D: BYTE POINTER TO REST OF THAT ENTRY'S TEXT
; C: "VALUE" FROM THAT TABLE ENTRY IN RH
; +4: INPUT EXACTLY MATCHES A TABLE ENTRY
; C: AS FOR +3
; AC'S UNCHANGED EXCEPT AS INDICATED
;TABLE FORM:
; LABEL: NUMBER OF ENTRIES
; XWD VALUE,[ASCIZ /TEXT/] PER ENTRY
; .
; .
; ENTRIES MUST BE ALPHABETICALLY ORDERED ON ASCII COLLATING SEQUENCE
; (AS OPPOSED TO ALGEBRAICALLY ORDERED ON 36-BIT WORD VALUES)
;AC USE
; A POINTS AT LAST ENTRY IN TABLE
; B POINTER WHICH IS INDEXED THRU INPUT TEXT
; C POINTER INTO TABLE
; D WORD OF INPUT TEXT
; E POINTER WHICH IS INDEXED THROUGH THE TEXT OF A TABLE ENTRY
; F WORD OF TEXT FROM TABLE ENTRY
; G "DELTA" - THE BINARY SEARCH INCREMENT
IFN E-D-1,<BARF> ;E=D+1 IS ASSUMED
;FSYM
;FSYM ENTRY
FSYM: PUSH P,A ;SAVE AC'S
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
PUSH P,G
HRRZ A,-6(P)
;INIT DELTA TO HIGHEST POWER OF 2 IN TABLE LENGTH
MOVE D,(A) ;TABLE LENGTH
JFFO D,.+2
JRST NOMAT ;0 LENGTH: NO MATCH
MOVEI G,1
MOVN E,E
LSH G,43(E) ;SHIFT BY 35 - # OF 0 BITS TO GET POWER
MOVEI C,(A) ;INIT POINTER THAT RUNS OVER TABLE
ADD A,(A) ;LOCATION OF LAST USED ENTRY IN TABLE
;FSRC1 FSRC1A FSRC2 UPAR APAR NOMAT FSRC3 FSRC4
;FSYM...
; BINARY SEARCH. STOPS AT = ENTRY OR SMALLEST > ENTRY.
FSRC1: ADDI C,(G) ;ADD DELTA TO TABLE POINTER
FSRC1A: LSH G,-1 ;HALVE DELTA FOR NEXT TIME AROUND
CAILE C,(A)
JRST FSRC4 ;POINTS BEYOND END OF TABLE, GO BACK UP.
;COMPARE THE INPUT TEXT TO A TEXT IN THE TABLE
MOVE B,-5(P) ;GET PTR TO INPUT TEXT SUPPLIED IN B
MOVE E,(C) ;POINTER INTO TABLE TEXT FROM TABLE WORD
FSRC2: MOVE D,(B) ;GET AN INPUT WORD
LSH D,-1 ;POSITION SO DATA ISN'T IN SIGN BIT
MOVEI B,1(B) ;INDEX INPUT POINTER
MOVE F,(E) ;GET A WORD OF TABLE TEXT
LSH F,-1
CAMGE F,D
JRST FSRC3 ;TABLE ENTRY LESS THAN INPUT
CAME F,D
JRST FSRC4 ;TABLE ENTRY GREATER THAN INPUT
TRNE D,177 ;THESE WORDS EQUAL, AT END OF INPUT?
AOJA E,FSRC2 ;NO, INDEX TABLE TEXT PTR, CONT. COMPARE
;MATCH FOUND.
;CODE FOR EXITS, SEARCH STUFF CONTINUES AFTER THIS.
AOS -7(P) ;INCREMENT RETURN ADDRESS
UPAR: AOS -7(P)
HLRZ D,(C) ;VALUE FIELD FROM ENTRY WHICH MATCHED
MOVEM D,-4(P) ;RETURN SAME IN C
APAR: ;AT THIS POINT C POINTS TO THE = OR SMALLEST > TABLE ENTRY
; & COULD BE RETURNED FOR USE IN INSERTION OR DELETION
AOS -7(P)
NOMAT: POP P,G ;RESTORE AC'S
POP P,F
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
RET ;RETURN
;THE TEXT OF THIS TABLE ENTRY IS LESS THAN INPUT STRING
FSRC3: JUMPN G,FSRC1 ;DELTA><0, MOVE DOWN AND CONTINUE SEARCH
AOJA C,NEM1 ;DONE SEARCH. NEXT ENTRY IN TABLE IS THE
;SMALLEST LARGER ENTRY. IF THERE IS NO NEXT ENTRY, THEN
;THERE IS NO MATCH. "SBST" SUBR IS CODED TO HANDLE THIS
;THIS TABLE ENTRY GREATER THAN INPUT, OR POINTER IS OF END OF TABLE
FSRC4: SUBI C,(G) ;MOVE UP IN TABLE
JUMPN G,FSRC1A ;UNLESS DELTA=0, CONTINUE SEARCH.
;NEM1 NEM2
;FSYM...
;WE GET TO "NEM1" WHEN THE SEARCH COMPLETES WITHOUT FINDING AN EXACT
;MATCH. C POINTS TO SMALLEST TABLE ENTRY GREATER THAN INPUT.
;THIS ENTRY MAY OR MAY NOT BE A SUBSET MATCH; IF IT IS, THEN IT IS
;AMBIGUOUS IF AND ONLY IF NEXT ENTRY IS ALSO A SUBSET MATCH.
;NOTE ALSO THAT WE CAN TEST NEXT ENTRY FIRST, AND IF IT IS SUBSET,
;THEN WE KNOW INPUT IS AMBIGUOUS WITHOUT TESTING THIS ENTRY.
;TEST NEXT ENTRY
NEM1: ADDI C,1 ;POINT C AT NEXT ENTRY
CALL SBST ;SUBSET TEST SUBR COMPARES ENTRY C TO INPUT
SOJA C,NEM2 ;R1: NOT A SUBSET (INCLUDES NO NEXT ENTRY)
SOJA C,APAR ;R2: IS A SUBSET, SO INPUT IS AMBIG. GIVE R2.
;NOT AMBIGUOUS, SO TEST THIS ENTRY
NEM2: CALL SBST
JRST NOMAT ;INPUT NOT SUBSET THIS ENTRY, NO MATCH
MOVEM E,-3(P) ;IS A SUBSET. RETURN BYTE POINTER TO REST OF
JRST UPAR ; TABLE ENTRY IN D. GIVE R2.
;SBST SBST1
;SUBROUTINE SBST FOR FSYM
;SUBSET TEST SUBROUTINE FOR "FSYM".
;COMPARES INPUT STRING AND STRING FOR TABLE ENTRY C POINTS TO,
; SKIPS IF FORMER IS INITIAL SUBSTRING OF LATTER.
;ON R2, RETURNS IN E A BYTE POINTER TO REST OF TABLE ENTRY STRING
;MUST BE CALLED ONLY WHEN INPUT STRING IS LESS THAN TABLE STRING
;SEE "FSYM"'S COMMENTS ON AC USE. CLOBBERS B,D,E,F,G.
SBST: CAILE C,(A) ;C BEYOND END OF TABLE?
RET ;YES, NO ENTRY, INPUT ISN'T SUBSET, RETURN.
;FIND FIRST WORD OF STRINGS IN WHICH THEY DIFFER
MOVE B,-6(P) ;POINTER TO INPUT TEXT
MOVE E,(C) ;POINTER TO TABLE ENTRY'S TEXT
SBST1: MOVE D,(B) ;WORD OF INPUT
LSH D,-1 ;POSITION FOR COMPARE
MOVEI B,1(B) ;INDEX INPUT POINTER
MOVE F,(E) ;WORD OF TABLE ENTRY
LSH F,-1 ;POSITION
CAMGE F,D ;REMOVE AFTER DEBUGGING
CALL SCREWUP ;.. GO TO EXEC'S PROGRAM ERROR ROUTINE
CAMG F,D
AOJA E,SBST1 ;IF ITS = IT MUST NOT BE END.
TRNE D,177 ;IS DIFFERENCE IN LAST WORD OF INPUT?
RET ;NO, INPUT CAN'T BE SUBSTRING OF TABLE ENTRY.
;MASK OFF TABLE TEXT TO LENGTH OF INPUT
HRLZI G,-4
TDNE D, [-1 ;LOOP TO SEE HOW MANY BYTES OF D ARE 0
1777777777
7777777
37777
177 ] (G) ;YES, (G).
AOBJN G,.-1
ANDCM F,@.-2 ;THIS CLEARS F WHERE THERE ARE BITS IN TABLE
;CONVERT WORD PTR IN E TO BYTE POINTER AS REQUIRED ON R2.
HLL E, [POINT 7,0,-1
POINT 7,0,6
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27 ] (G)
;NOW IF MASKED PART OF TABLE WORD = INPUT WORD, INPUT IS SUBSET.
CAMN F,D
AOS (P) ;SKIP
RET
;%NOI
;%NOI
;NOISE WORD UUO SERVICE ROUTINE ("NOISE" MACRO)
;
;ARGUMENT IS AN ASCIZ TEXT
;IF LAST TERMINATOR IS ALT MODE, TYPE " (<GIVEN TEXT>) ".
;IF SPACE, COMMA, OR COLON, PASS FOLLOWING PARENTHESIZED TEXT (IF ANY),
; REQUIRING THAT INPUT BE A PROPERLY ORDERED SUBSET OF GIVEN.
; AN ALT MODE IN PARENTHESIZED TEXT CAUSES REST OF GIVEN TO BE OUTPUT,
; AND "TRM" TO BE SET TO ALT MODE.
;IF !, SPECIAL BEHAVIOR FOR LOGIN COMMAND: TYPE " (<GIVEN TEXT>) ",
; THEN ALSO PASS PARENTHESIZED TEXT, IF ANY, AS AFTER SPACE (IN CASE
; A COMMAND FILE, MIMICING A TYPESCRIPT, CONTAINS THE TEXT).
;IF LEFT PAREN, SIMILARLY PASS TEXT TO ) OR ALT MODE.
;OTHER TERMINATORS PRODUCE NO ACTION.
;
;CAVEAT: IF TRM IS SPACE OR COMMA AND THERE IS NO (TEXT),
; %NOI HAS READ AHEAD ONE INPUT FIELD (AND SET BAKFF). SO DON'T
; TRY TO OUTPUT ANYTHING BETWEEN CALL TO %NOI AND NEXT INPUT.
%NOI: PUSH P,40 ;SAVE ARGUMENT ADDRESS
TRNE CBT,TLPR
JRST NOI0
CAIE TRM,"!"
TRNE CBT,TALT
;FOR ALT MODE OR ! TYPE GIVEN TEXT
JRST [U$TYPE [ASCIZ /(/]
POP P,40
PUSH P,40 ;KEEP IT IN PD ALSO
U$TYPE @40
U$TYPE [ASCIZ /) /]
CAIE TRM,"!"
JRST [ POP P,40
RET]
;THE FOLLOWING IS JUST LIKE "JRST NOIA"
;EXCEPT ECHOING, IF OFF, IS NOT TURNED ON.
TLO Z,NEOLF
CALL CSTR
CAIN TRM,"("
CAILE CNT,1
JRST [ TLO Z,BAKFF
JRST [ POP P,40
RET]]
JRST NOI0A]
TRNN CBT,TSPC+TCOM+TCOL ;SPACE, TAB, COMMA, OR COLON?
JRST [ POP P,40 ;OtHER TERMINATORS IGNORED
RET]
;NOIA NOI0 NOI0A
;%NOI...
;SPACE AND COMMA GET HERE
;PASS UP (TEXT), WHERE TEXT IS ANY SUBSET OF GIVEN IN ORIGINAL ORDER,
;WITH ANY NUMBER OF ADDED SPACES.
;FIRST WE MUST SEE IF NEXT CHARACTER IS "(". BEFORE DOING THIS, WE
;MUST INPUT AN ENTIRE FIELD, TO MAKE EDITING CHARACTERS WORK
;RIGHT (CONSIDER THE CASE WHERE USER TYPES LETTER, BAKSLASH, "(" ).
NOIA: TLO Z,NEOLF ;DON'T ECHO EOLS - FIELD MAY BE A FILE NAME
CALL CSTR ;INPUT A FIELD
CAIN TRM,"(" ;WAS INPUT "(",
CAILE CNT,1 ;WITH NOTHING BEFORE IT?
JRST [ TLO Z,BAKFF ;NO "(". BACK OUT AND RETURN.
;UNECHOED EOL WILL BE ECHOED IF APPROPRIATE AT NEXT
;"CSTR" OR AT "CONF"
JRST [ POP P,40
RET]]
TLNE Z,NECHOF ;ECHOING OFF (PASSWORD) ?
PRINT (TRM) ;YES, PRINT THE "(".
;INPUT CHARACTERS TILL ) OR ALT MODE.
;CAN'T PROCESS DURING INPUT BECAUSE OF EDITING.
; ( AS LAST TERMINATOR COMES HERE
NOI0: TLNE Z,NECHOF ;ECHOING OFF?
CALL DOECHO ;YES, PUT IT ON SO NOISE WORD IS ECHOED
NOI0A: CALL CSTR ;INPUT TILL ANY TERMINATOR
TRNE CBT,TRPR+TALT ; ) OR ALT MODE?
JRST NOI1
TRNE CBT,TSPC ;SPACE OR TAB?
JRST MORE ;AFTER SPACE GET MORE (RETURNS TO .-4)
JRST CERR ;EOL, SEMICOLON, COMMA, ETC ILLEGAL HERE.
;NOI1 IGNOI2 IGNOI1 IGNOI3
;%NOI...
;MATCH LOOP: INPUT CHAR IS OK IF IT MATCHES A CHARACTER IN GIVEN
;STRING AFTER LAST ONE MATCHED. IGNORE SPACES IN BOTH STRINGS.
NOI1: EXCH A,(P) ;SAVE A, GET POINTER TO GIVEN.
PUSH P,B
PUSH P,C
PUSH P,D
HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE PTR TO GIVEN
MOVE C,.BFP ;BYTE PTR TO INPUT
IGNOI2: ILDB D,C ;GET AN INPUT CHARACTER
CAIL D,141 ;ASCII LOWER CASE A
CAILE D,172 ;ASCII LOWER CASE Z
JRST .+2 ;NOT A LOWER CASE LETTER
SUBI D,40 ;CONVERT LOWER CASE TO UPPER
CAIE D,TAB
CAIN D," "
JRST IGNOI2
CAIN D,")"
; RIGHT PAREN TERMINATES LOOP
IGNOI1: JRST [POP P,D ;EXIT
POP P,C
POP P,B
POP P,A
RET ]
CAIN D,ALTM
;ON ALT MODE TERMINATION, PRINT REST OF GIVEN AND ).
JRST [CALL UBP ;BACK UP BFP TO UNBUFFER ALT MODE
TLO Z,STCF ;SAY APPEND PRINTED CHARS TO CWBUF
CALL CTYPE ;PRINT REST OF GIVEN (A POINTS TO IT)
UTYPE [ASCIZ /) /] ;ADD ) AND SPACE TO IT
TLZ Z,STCF
JRST IGNOI1] ;EXIT
IGNOI3: ILDB B,A ;GET A GIVEN CHARACTER
CAIL B,141 ;LOWER CASE A
CAILE B,172 ;LOWER CASE Z
CAIA ;NOT A LOWER CASE LETTER
SUBI B,40 ;GIVE IT A RAISE
CAIN B," "
JRST IGNOI3
JUMPE B,CERR ;MATCH FAILS IF GIVEN ENDS BEFORE INPUT
CAME B,D ;MATCH?
JRST IGNOI3 ;NO, TRY NEXT GIVEN ON SAME INPUT CHAR
JRST IGNOI2 ;YES, GO TO NEXT CHAR IN BOTH STRINGS
;%SBCOM SBCOM1 SBCOM9
;SBCOM UUO
;INPUT AND DISPATCH ON SUBCOMMANDS, USING TABLE EFFECTIVE ADDR POINTS TO
;TERMINATES ON NULL SUBCOMMAND OR ONE WITH 0 DISPATCH ADDRESS
;USES INCLUDE DIRECTORY, COPY, PRINT, CREATE, TYPE/LIST
%SBCOM: PUSH P,CERET
PUSH P,.P
PUSH P,.JBUFP
PUSH P,KWV1
PUSH P,E
PUSH P,40
SBCOM1: MOVEI A,SBCOM1
MOVEM A,CERET ;SAY COME BACK HERE AFTER PRINTING ERROR MESSAGE
MOVEM P,.P ;PD LEVEL TO RESTORE AFTER ERROR
MOVE A,JBUFP
MOVEM A,.JBUFP ;JFN STACK LEVEL TO BE RESTORED AFTER ERROR
MOVE BFP,[POINT 7,CBUF,-1] ;COMMAND STRING BUFFER POINTER
CALL READY2 ;TYPE 2 READY CHARACTERS: @@ OR !!
SETZB TRM,CBT ;CLEAR TERMINATOR AND BITS: EOL HERE WOULD
;MAKE "KEYWD" DEFAULT THO IT SHOULDN'T.
TLZ Z,BAKFF+PUNCF+NEOLF+EOLNEF+DASHF
;AN OBSCURE CASE IN "DIRECTORY" LEAVES NEOLF ON,
;WHICH TURNS EOLNEF ON IN CONFIRM, WHICH SCREWS UP
;FOLLOWING "KEYWD".
KEYWD @(P) ;INPUT A KEYWORD AND LOOK UP IN CALLER'S TABLE
T <>,ONEWD,SBCOM9 ;NULL DEFAULTS TO THIS.
JRST CERR ;ERROR IF NOT FOUND IN TABLE
TLZ Z,F1 ;REQUIRED BY SOME COMMANDS, EG "CREATE".
MOVE KWV1,KWV ;SAVE KEYWORD'S BITS FOR "CONFIRM" ETC
TLNE KWV1,ONEWD ;IF "ONE WORD COMMAND" BIT ON,
CONFIRM ;CONFIRM BEFORE DISPATCH
MOVE E,-1(P) ;PRESERVE E FOR "CREATE"
;(I DON'T THINK IT CAN GET CLOBBERED ANYWAY)
TRNN KWV1,-1
CALL SBCOM9 ;0 DISPATCH ADDRESS MEANS TERMINATE SUBCOMMANDS
CALL (KWV1) ;CALL CALLER'S ROUTINE FOR THIS SUBCOMMAND
MOVEM E,-1(P)
JRST SBCOM1 ;GO GET ANOTHER
;TERMINATING SUBCOMMAND INPUT
SBCOM9: SUB P,[XWD 2,2] ;FORGET SUBCOMMAND RETURN AND 40
POP P,E
POP P,KWV1
POP P,.JBUFP
POP P,.P
POP P,CERET
RET
;%INHEL UINHE9
;UINHEL UUO (INHELP MACRO)
;INPUT STRING WITH CSTR (NEXT). IF STRING CONSISTS OF "?" ONLY,
; OR ? AND A TERMINATOR, "ETYPE" THE MESSAGE THE EFFECTIVE ADDRESS
;POINTS TO, RETYPE COMMAND LINE SO FAR, AND INPUT ANOTHER STRING.
%INHEL: PUSH P,A
PUSH P,40
CALL CSTR
CAILE CNT,2
JRST UINHE9 ;TOO LONG
MOVE A,.BFP
ILDB A,A ;FIRST CHARACTER
CAIE A,"?"
JRST UINHE9 ;NOT "?"
MOVE BFP,.BFP ;DISCARD "?" STRING
PRINT " "
MOVE A,-1(P) ;CALLER'S A FOR ETYPE
UETYPE @(P) ;GIVEN MESSAGE
CAMN BFP,[POINT 7,CBUF,-1] ;AFTER NULL COMMAND,
U.$ERR 0 ;USE ERROR CODE TO RESTORE P, RETYPE READY
;CHARACTERS, RESTART COMMAND. U.$ERR DOESN'T
;CLEAR INBUF, 0 MEANS NO MESSAGE. NOTE THAT
;AT LEAST THE FIRST FEW AC'S AREN'T RESTORED.
ETYPE (%Y) ;RETYPE INPUT LINE
CALL CSTR ;INPUT ANOTHER STRING
;EXIT: FIX THINGS UP SO "MORE" CAN BE USED AS AFTER A CALL
; DIRECTLY TO "CSTR".
UINHE9: SUB P,[XWD 1,1] ;FORGET 40
POP P,A
POP P,CSTRR ;STORE RETURN FOR USE BY "MORE"
JRST @CSTRR
;CSTR AND MORE
;INPUT A FIELD SUBROUTINE (CSTR),
;AND APPEND TO FIELD REENTRY POINT (MORE).
;FIELD CONSISTS OF 0 OR MORE CHARACTERS CONSISTING OF
; LETTERS AND DIGITS, AND ALSO PUNCTUATION IF "PUNCF" IS ON.
; "-" IS ACCEPTED IN FIELD TO SIMPLIFY CODING "-" FOR NULL FIELD.
;ANY OTHER CHARACTER IS FIELD TERMINATOR.
;FLAG "BAKFF" CAUSES PREVIOUSLY INPUT FIELD TO BE USED AGAIN.
; CAVEAT: EXACTLY THE SAME FIELD IS AGAIN RETURNED IF "PUNCF"
; WAS ON AND HAS BEEN TURNED OFF.
; NO KNOWN CASES WHERE THIS MATTERS. 3/4/70
;FLAG "NEOLF" SUPPRESSES EOL ECHOING. THIS IS USED WHEN A FILE
; NAME IS BEING INPUT, BECAUSE "GTJFN" PRINTS EOL WHERE
; APPROPRIATE EVEN IF EOL IS IN STRING NOT ON FILE.
;
;ACCEPTS: "BFP": POINTER TO CURRENT END OF COMMAND STRING
; "MORE" ALSO REQUIRES THAT .BFP, CNT, CHR, TRM, AND CBT
; HAVEN'T BEEN CLOBBERED.
;RETURNS: "BFP": NEW END
; ".BFP": BEGINNING = OLD END
; "CNT": # OF CHARACTERS IN FIELD
; (USED BY ↑A AND ↑W SO MUST BE PRESERVED IF "MORE" IS USED)
; "TRM" AND "CHR": TERMINATING CHARACTER
; "CBT": CHRTBL WORD FOR TERMINATING CHAR -- DESCRIPTIVE BITS
; SUCH AS "TEOL", "OCTDIG", ETC.
; FLAGS BAKFF, PUNCF, NEOLF CLEAR
; FLAG EOLNEF SET IF UNECHOED EOL INPUT
;
;"MORE" DOESN'T INITIALIZE .BFP AND CNT.
;"MORE" RETURNS TO WHERE "CSTR" WAS LAST CALLED FROM.
; BEWARE OF PD LEVEL BEING DIFFERENT!
;CSTR CSTR0 CSTR1 CSTR2 CSTR3 CSTR5
;CSTR AND MORE...
;BEGIN NEW FIELD ENTRY
CSTR: POP P,CSTRR ;SO "MORE" RETURNS SAME PLACE
TLNE Z,NEOLF ;SUPPRESSION OF EOL ECHOING REQUESTED?
;THIS FEATURE IS USED WHEN READING A STRING TO
;BE FED TO GTJFN, WHICH PRINTS THE EOL ITSELF.
JRST [ CALL NOECEO ;YES, CHANGE CCOC SO EOL'S NOT PRINTED
JRST CSTR0]
TLZE Z,EOLNEF ;NO. ECHO PREVIOUSLY UNECHOED EOL FROM PRECEDING
PRINT EOL ;FIELD OR FROM THIS FIELD IF BAKFF ON.
CSTR0: TLZE Z,BAKFF ;TEST AND CLEAR "RE-USE SAME FIELD" FLAG
;RE-USE SAME FIELD: CHECK LAST TERMINATOR AGAIN, TO
;MAKE IT READ MORE IN THE CASE WHERE "PUNCF" WAS OFF AND NOW
;IS ON. THIS CAN HAPPEN IN FILE NAME COLLECTION.
JRST CSTR2 ;(USUALLY JUST EXITS.)
CALL NALNBK ;SET BREAK SET TO NON-ALPHANUMERICS
CSTR1: MOVE .BFP,BFP ;BEGIN A NEW INPUT FIELD TO PREVENT
SETZ CNT, ;...EDITING.
CALL CCHRI ;INPUT A CHARACTER, STORE, PROCESS EDIT CHARS
CSTR2: TLNE Z,CTRLVF ;IF PRECEDED BY ↑V,
JUMPN CHR,CSTR3 ;ANY CHAR BUT NULL IS PART OF FIELD.
TRNN CBT,ALPHAN ;IS IT ALPHANUMERIC (INCLUDES "-")?
JRST CSTR5 ;NO.
CSTR3: CALL CCHRI ;YES, INPUT AND STORE NEXT CHARACTER.
JRST CSTR2
;HAVE A NON-ALPHANUMERIC CHARACTER
CSTR5: TLNE Z,PUNCF ;ARE WE ALLOWING PUNCTUATION IN FIELD?
TRNN CBT,PUNBIT ;YES, IS IT A PUNCTUATION CHARACTER?
JRST .+2
JRST CSTR3
;CSTR9
;CSTR AND MORE...
;HAVE PROBABLE TERMINATOR.
;BUT IF ITS SPACE OR TAB AND CNT=1, THEN ITS A LEADING CHARACTER THAT
; MUST BE IGNORED.
;LEADING CHARACTERS MUST BE IGNOZED HERE, NOT IN A LOOP AT BEGINNING
; OF FIELD INPUT, TO HANDLE CASE WHERE TYPIST DELETES ENTIRE
; FIELD WITH EDITING CHARACTERS, THEN TYPES A SPACE OR TAB.
CAIG CNT,1 ;ANY CHARS BEFORE IT?
JRST [ TRNE CBT,TSPC ;IS IT A SPACE, TAB, OR & ?
JRST CSTR1 ;YES, IGNORE IT.
JRST .+1] ;NO, IT TERMINATES FIELD.
;REALLY HAVE TERMINATOR
MOVE TRM,CHR
PUSH P,A
PUSH P,B
SETZ A,
MOVE B,BFP
IDPB A,B ;STORE 0 AFTER STRING. NEEDED FOR FILE NAMES.
POP P,B
POP P,A
CSTR9: TLZ Z,PUNCF ;CLEAR "PUNCTUATION CHARACTERS ALLOWED" FLAG
TLZE Z,NEOLF ;CLEAR "DON'T ECHO EOLS" FLAG
CALL DOECEO ;AND CHANGE CCOC SO EOLS WILL PRINT
PUSH P,CSTRR ;RETURN
RET
;ENTRY TO ADD MORE CHARACTERS TO SAME FIELD AND RETURN TO WHERE "CSTR"
;WAS CALLED.
MORE=CSTR3
;PASCOM PASCM1 %ALLOW
;PASCOM
;SUBROUTINE TO PASS COMMENT, IF ANY.
;IF TRM=;, IGNORE INPUT TO EOL.
;DO IT BY FIELDS FOR CONSISTENT BEHAVIOR OF EDITING CHARACTERS.
;BUT LEAVE AC'S SET FOR PRECEDING FIELD.
PASCOM: TRNN Z,CTRLVF ;I'VE FORGOTTEN WHY ↑V; DOESN'T COUNT
CAIE TRM,";"
RET ;NO COMMENT
PUSH P,.BFP
PUSH P,CNT
PUSH P,CHR
PUSH P,TRM
PUSH P,CBT
PASCM1: CALL CSTR
CAIN TRM,FORMF
JRST .+3
CAIE TRM,EOL
JRST PASCM1
POP P,CBT
POP P,TRM
POP P,CHR
POP P,CNT
POP P,.BFP
RET
;SERVICE ROUTINE FOR "ALLOW" UUO.
;CHECKS THAT LAST CHARACTER (USUALLY FIELD TERMINATOR) IS AS
;DESCRIBED BY BITS IN EFFECTIVE ADDRESS.
;IE MAKES SURE E OR'D WITH C(CBT) >< 0.
%ALLOW: TRNN CBT,@40
JRST CERR
RET
;CONF CONF2
;CONF
;CONFIRMATION AND COMMAND TERMINATION SUBROUTINE
;ALL COMMANDS, EVEN NON-CONFIRMATION ONES, SHOULD CALL THIS.
;USES KWV1,TRM AND DOES THE FOLLOWING:
; IF PROGX, THE THING (BEING RUN?) GETS THE REST OF THE COMMAND LINE
; SO NO SCANNING FOR EOL'S ETC. IS PERMITTED.
; IF BAKFF ON, ERROR UNLESS CNT=1.
; IF TRM=; , INPUT CHARS TO EOL AND EXIT.
; IF NOCONF ON, TYPE EOL UNLESS TRM=EOL OR FORMFEED AND EXIT.
; IF TRM><EOL OR IF CONMAN ON, INPUT CHARACTERS TILL NON-SPACE.
; BUT IF BAKFF ON, FALL THRU WITHOUT INPUTTING CHARACTERS.
; IF EOL, EXIT.
; IF ; , INPUT CHARS TILL EOL AND EXIT.
; IF ALT MODE AND "ALTCON" ON, TYPE CR AND EXIT.
; ELSE ERROR: TYPE " ? " AND LET USER TRY AGAIN.
; ANY CHARACTER PRECEDED BY ↑V GETS ERROR TREATMENT
CONF: TLZE Z,EOLNEF ;IS THERE AN UNECHOED EOL?
PRINT EOL ;YES, ECHO IT NOW
TLNE KWV1,PROGX ;PASSING CONTROL TO A PROGRAM?
RET ;YES. IT GETS THE REST OF LINE
TLNN KWV1,CONFRC
JRST CONF2
;FORCED CONFIRMATION FOR CERTAIN COMMANDS:
;ALWAYS TYPE "[CONFIRM:]" ON NEXT LINE AND REQUIRE EOL.
CALL PASCOM ;CHEW UP COMMENT IF ANY (PRESERVES TRM)
CAIN TRM,";"
MOVEI TRM,EOL ;DONT INPUT COMMENT AGAIN AT "CONF7".
TRNN CBT,TEOL ;NEED WE "RFPOS" HERE?
PRINT EOL ;IF CARRIAGE ISN'T AT LEFT, PUT IT THERE
CONF2: ; ... CAUSES "[CONFIRM:]" TO BE TYPED BELOW.
;IF THERE IS A FIELD WHICH HAS BEEN INPUT BUT NOT USED, IT MUST BE NULL.
;(SUCH A FIELD CAN OCCUR IF COMMAND ENDS IN A NOISE WORD AND THE
; USER TERMINATES WITH SPACE AND OMITS THE NOISE, BUT POSSIBLY
; TYPES SOME OTHER GARBAGE.)
TLNE Z,BAKFF ;UNUSED INPUT FIELD?
JRST [ CAILE CNT,1
JRST CERR ;NON-NULL, USER TYPED GARBAGE
JRST .+1]
CAIN TRM,";"
JRST CONF7 ; ; AS LAST FIELD TERMINATOR.
TLNE KWV1,NOCONF
JRST [ TRNN CBT,TEOL
PRINT EOL
RET]
MOVE CHR,TRM ;(SHOULD BE THERE ANYWAY)
TLNN KWV1,CONMAN+CONFRC ;FLAGS SAY ALWAYS CONFIRM
TRNN CBT,TEOL ;A CR ALWAYS ENDS THE CMND IF CONMAN OFF
TLNE Z,BAKFF ;IF, UNUSED FIELD USE ITS TERMINATOR
JRST CONF8
;CONF6 CONF7 CONF8 CONF9 CONFE CONFE1
;CONF...
;READ A CHARACTER TO CONFIRM COMMAND.
;FIRST TYPE " [CONFIRM:] " IF AT LEFT MARGIN. SHOULD ONLY HAPPEN IF
; CONMAN ON AND USER ENDED LAST FIELD WITH CR AND COMMAND
; DIDN'T JUST TYPE OLD FILE/NEW FILE.
PUSH P,A
PUSH P,B
MOVE A,COJFN
RFPOS ;READ FILE POSITION
TLZ B,-1
CAIG B,2
TYPE < [Confirm] >
POP P,B
POP P,A
CALL ALLBK ;SET BREAK SET TO ALL CHARACTERS
CONF6: MOVE .BFP,BFP ;NEW FIELD PREVENTS INVALID EDITING
SETZ CNT, ;...
CALL CCHRI ;INPUT CHARACTER
TRNE CBT,TSPC
JRST CONF6 ;IGNORE PRECEDING SPACES AND TABS
MOVE TRM,CHR
CONF7: CALL PASCOM ;IF ;, IGNORE CHARACTERS TIL EOL
CONF8: TLNE Z,CTRLVF
JRST CONFE ;↑V ALWAYS LOOSES
TRNE CBT,TEOL ;EOL OR ; OR FORMFEED
JRST CONF9 ;SUCCESS
CAIN CHR,ALTM
JRST [ TLNN KWV1,ALTCON ;ALT MODE. OK AS TERMINATOR?
JRST CONFE ;NO, TYPE " ? " AND RETRY
PRINT EOL
JRST CONF9]
JRST CONFE
;CONFIRMATION SUCCESSFUL
CONF9: TLZ Z,BAKFF ;REALLY MATTERS, EG, FOR "↑E PRINT"
RET
;CONFIRMATION FAILURE
;ON "?" TYPE EXPLANATORY MESSAGE, RETYPE COMMAND, ALLOW RETRY
CONFE: CAIG CNT,1
CAIE CHR,"?"
JRST CONFE1 ;NOT "?"
MOVE BFP,.BFP ;REMOVE THE "?" FROM THE COMMAND LINE
ETYPE < Confirm with carriage return%Y>; %Y RETYPES COMMAND
JRST CONF6 ;GO INPUT CONFIRMATION CHARACTER AGAIN
CONFE1: TYPE < ? > ;KEEP TRYING TILL HE TYPES ↑X OR ↑C.
BTCHER ;STOP NON-CONVERSATIONAL JOB
MOVE BFP,.BFP ;FORGET BAD CONFIRMATION CHAR (FOR ↑R)
JRST CONF6 ;GO TRY AGAIN
;TCONF TCONF1 TCONFC TCONFX TCONFR
;TCONF
;CONFIRMATION ROUTINE (LIKE CONF) INTENDED TO BE USED DURING COMMAND
;EXECUTION. DIFFERS FROM CONF IN THAT IT IS TRANSPARENT TO MOST AC'S
;AND HAS SEPARATE CONFIRMATION AND NON-CONFIRMATION RETURNS.
; CALL TCONF
; RET +1: NOT CONFIRMED (I.E. ↑X OR TUROUT)
; RET +2: CONFIRMED (CR, EOL, ETC.)
;NOTE THIS ROUTINE PROBABLY OUGHT TO BE IMPLEMENTED AS A SPECIAL CALL
;TO CONF, BUT HTAT REQUIRES SAVING INCREDIBLE AMOUNTS OF STATE
;(INCLUDING THE CONTENTS OF CSBUF!)
TCONF: CALL DOECEO ;ENSURE CR WILL ECHO
CALL ALLBK ;BREAK ON ALL TYPED IN CHARACTERS
PUSH P,EOFDSP ;CALLER (LIST) MIGHT HAVE ITS OWN TRAP
MOVEI A,CCHEOF ;ROUTINE TO HANDLE EOF
MOVEM A,EOFDSP
TCONF1: MOVE A,CIJFN
CFIBF ;FLUSH TYPEAHEAD TO AVOID CONFUSION
BIN ;GET CONFIRMATION CHARACTER
CAIN B,177
JRST TCONFR ;RUBOUT
CAIN B,"X"-100
JRST TCONFX ;↑X
CAIN B,15 ;CR, EXPECT TO SEE LF AFTER SO READ IT
BIN
CAIE B,37
CAIN B,12
JRST TCONFC ;EOL OR LF, CONFIRMATION
TYPE < ? > ;SOMETHING ELSE, KEEP TRYING UNTIL
JRST TCONF1 ;USER TYPES EOL OR RUBOUT
TCONFC: AOSA -1(P) ;HERE FOR CONFIRMATION EXIT
TCONFX: TYPE <↑X
>
POP P,EOFDSP ;RESTORE PREVIOUS EOF DISPATCH
RET
TCONFR: TYPE <XXX
>
POP P,EOFDSP ;RESTORE PREVIOUS EOF DISPATCH
RET
;SPRTR
;SPRTR
;TEST TERMINATOR (SEPARATOR) AND MAYBE READ AND TEST THE NEXT FIELD,
; TO DETERMINE WHETHER THERE'S A COMMA NEXT (R2), THE END OF THE
; COMMAND (R3), OR GARBAGE OR ANOTHER ARG WITHOUT A COMMA (R1).
;
;TYPICAL USES: AFTER "DIRECTORY" OR "TYPE", TO SEE IF THERE IS
; A COMMA TO INITIATE SUBCOMMAND INPUT, OR A FILE NAME ARG (NOT
; SEPARATED WITH COMMA), OR NEITHER; BETWEEN ARGS IN A LIST
; SEPARATED WITH COMMAS, AS IN SOME SUBCOMMANDS OF "CREATE".
;
;IN MORE DETAIL:
; RETURN +1:
; ALT MODE OR SPACE NOT FOLLOWED IMMEDIATELY BY COMMA, EOL, OR
; ALT MODE, IE FOLLOWED BY SOME OTHER TERMINATOR, OR AN
; ALPHANUMERIC FIELD. BAKFF SET, READY TO PROCESS FIELD.
;
; RETURN +2:
; COMMA, PERHAPS PRECEDED BY SPACE OR ALT MODE.
; READY TO INPUT SUBCOMMANDS OR NEXT ARG OF LIST.
;
; RETURN +3:
; EOL, SPACE-EOL, SPACE-ALT MODE, ALT MODE-EOL, OR 2 ALT MODES.
; BAKFF SET EXCEPT IN EOL CASE, READY TO CALL "CONF".
;
;CAVEAT: DON'T CALL THIS FOR A COMMAND WITH "CONFRC" BIT SET,
; BECAUSE IT CAN READ CONFIRMING CHARACTER BEFORE CONF HAS HAD
; ITS CHANCE TO TYPE "[CONFIRM:]".
SPRTR: TRNE CBT,TEOL
AOS (P) ;EOL. R3.
TRNE CBT,TCOM+TEOL
JRST [ AOS (P) ;COMMA GETS R2.
RET]
ALLOW TSPC+TALT ;ERR IF CHAR NOT EOL, COMMA, SPACE, OR ALT MODE.
CALL CSTR ;AFTER SPACE OR ALT MODE GET NEXT FIELD.
CAIGE CNT,2 ;NON-NULL, ALWAYS BACK UP AND GIVE R1.
TRNN CBT,TCOM+TEOL+TALT ;ALSO BAKUP & R1 IF NOT COM, EOL, ALTM.
JRST [ TLO Z,BAKFF
RET]
AOS (P)
TRNE CBT,TCOM
RET ;NULL, COMMA: R2 WITHOUT BACKUP.
TLO Z,BAKFF ;NULL, ALT MODE OR EOL: BACK UP, R3.
JRST [ AOS (P)
RET]
;CCHRI CCHR1 CCHR8
;CCHRI
;INPUT A CHARACTER FOR COMMAND STRING INTO "CHR".
;RETURNS IN AC "CBT" THE CHARACTER'S WORD IN THE CHARACTER TABLE --
; THIS CONTAINS DESCRIPTIVE BITS (SEE COMMENTS ABOVE "CHRTBL")
;STORES IN CBUF (POINTER CBP)
;EDITING CHARACTERS:
; ↑A DELETE CHAR (CAN ONLY DELETE TO BEGINNING OF FIELD)
; ↑W DELETE FIELD (CAN ONLY DELETE CURRENT ONE)
; ↑X DELETE LINE (DOESN'T RETURN TO CALLER)
; ↑R RETYPE LINE ? IF COLLECT FILE NAME IS COMPATIBLE.
; ↑V GET ANOTHER CHARACTER AND RETURN IT EVEN IF ITS AN EDITING CHAR,
; & RETURN "CTRLVF" ON.
;OTHER SPECIAL CHARACTERS:
; ( IF ECHOING OFF, TURN IT ON AND PRINT "(".
; THIS KLUDGE IS NECESSARY BECAUSE NOISE WORD CAN BE TYPED IN
; BEFORE PASSWORD.
;CALLERS MUST CLEAR CHARS-IN-FIELD COUNTER (CNT) AT BEGINNING OF EACH
;NEW FIELD.
CCHRI: PUSH P,A
PUSH P,B
MOVEI A,CCHEOF
MOVEM A,EOFDSP ;SETUP TO DETECT EOF ON COMMAND INPUT
TLZ Z,CTRLVF ;SAY NO ↑V (YET) BEFORE THIS CHARACTER
;RETURN HERE AFTER PROCESSING SPECIAL CHARACTER
;GET CHARACTER INTO "CHR", BITS INTO "CBT", DISPATCH IF SPECIAL
CCHR1: MOVE A,CIJFN ;INPUT SOURCE DESIGNATOR
BIN ;INPUT CHARACTER TO B
CAIN 2,12 ;LF?
MOVEI 2,EOL ;YES, MAKE LIKE EOL
CAIN B,15 ;REAL CR?
JRST [ BIN ;YES, ASSUME LF FOLLOWING
MOVEI 2,EOL ;AND REPLACE WITH EOL
JRST .+1]
MOVE CHR,B
AOS TTYACF ;SAY THERE'S BEEN TTY ACTIVITY, SO JOB
;WON'T GET AUTOLOGOUTED FOR LACK THEREOF
MOVE CBT,CHRTBL(CHR) ;BITS WORD FROM CHARACTER TABLE
TLNE Z,CTRLVF ;PRECEDED BY ↑V?
JRST CCHR8 ;YES, NO SPECIAL PROCESSING
TLNE CBT,-1 ;HAS A SPECIAL-CASE DISPATCH ADDR?
JRST [ HLRZ B,CBT ;YES, DISPATCH.
JRST (B)]
;NOT SPECIAL. CHECK FOR COMMAND TOO LONG, STORE CHARACTER.
CCHR8: HRRZ B,BFP
CAIL B,CBUFE
ERROR <Command too long>
AOJ CNT,
IDPB CHR,BFP ;STORE CHARACTEB IN COMMAND BUFFER
SETZM EOFDSP
POP P,B
POP P,A
RET
;$CTRLH $CTRLA CTRLA1 CTRLA2 CTRLA3 $CTRLW CTRLW1 CTRLW2 $CTRLR $CTRLX $RUB
;CCHRI...
;ROUTINES FOR SPECIAL CHARACTERS
;PROCESS ↑H
$CTRLH: PRINT " " ;THEN FALL INTO ↑A ROUTINE
;PROCESS ↑A
$CTRLA: SKIPG CNT ;ANY DELETEABLE CHARACTERS?
JRST [ CALL DING ;NO, RING BELL
JRST CCHR1] ;INPUT ANOTHER CHARACTER
PUSH P,A
PUSH P,C
MOVE A,COJFN
GTTYP ;GET TERMINAL TYPE
POP P,C
POP P,A
CAIN B,12
JRST CTRLA1 ;SCOPE
TRZ B,10
CAIL B,4
CAILE B,5
JRST CTRLA2 ;PRINTING TERMINAL
CTRLA1: TLNE Z,NECHOF ;SCOPE
JRST CTRLA3 ;DON'T BACKSPACE IF ECHOING IS OFF
UTYPE [ASCIZ /λ λ/] ;PRINT BACKSPACE, SPACE, BACKSPACE
JRST CTRLA3
CTRLA2: PRINT "\" ;ECHO \
LDB B,BFP
TLNN Z,NECHOF ;DON'T PRINT IF ECHOING IS OFF
CALL CCHRO ;DELETED CHARACTER
CTRLA3: CALL UBP ;BACK UP BFP AND CNT
JRST CCHR1 ;GET ANOTHER INPUT CHARACTER
;PROCESS ↑W
$CTRLW: SKIPG CNT
JRST [ CALL DING ;NO FIELD TO DELETE
JRST CCHR1]
PUSH P,A
PUSH P,C
MOVE A,COJFN
GTTYP ;GET TERMINAL TYPE
POP P,C
POP P,A
CAIN B,12
JRST CTRLW1 ;SCOPE
TRZ B,10
CAIL B,4
CAILE B,5
JRST CTRLW2 ;PRINTING TERMINAL
CTRLW1: TLNN Z,NECHOF ;SCOPE
UTYPE [ASCIZ /λ λ/] ;PRINT BACKSPACE, SPACE, BACKSPACE
CALL UBP
JUMPG CNT,CTRLW1
JRST CCHR1
CTRLW2: UTYPE [ASCIZ /←/]
CALL UBP
JUMPG CNT,.-1
JRST CCHR1
;PROCESS ↑R
$CTRLR: TLNE Z,NECHOF ;IS ECHOING OFF?
JRST [ CALL DING ;YES
JRST CCHR1] ;GO GET NEXT CHAR
CALL DOECEO ;MAKE SURE EOL WILL PRINT
SETZ CHR,
MOVE B,BFP
IDPB CHR,B ;TERMINATE WITH 0
PRINT EOL
PRINT " "
UTYPE CBUF ;TYPE CR, SPACE, COMMAND BUFFER
TLNE Z,NEOLF ;IF EOL ECHO SUPPRESSION IN EFFECT,
CALL NOECEO ;CHANGE CCOC BACK SO EOL'S WON'T PRINT
JRST CCHR1
;PROCESS ↑X
$CTRLX: .$ERROR <↑X>; XXX?
;PROCESS RUBOUT (LATER A PSI(?))
$RUB: .$ERROR <XXX> ;.$ERROR MEANS NO CR FIRST, NO CLR INBUF
;$FORMF FORMF1 $EOL $DASH $CTRLV $CONT
;CCHRI... ROUTINES FOR SPECIAL CHARACTERS...
;PROCESS ↑L (FORMFEED)
$FORMF: CALL DOECEO ;MAKE EOL'S PRINT
PRINT EOL ;ECHO CR-LF AFTER FORMFEED
;ABOVE FAILS IF FORM FEED IS BACKED UP OVER: TWO EOL'S ECHOED.
;DON'T THINK IT CAN HAPPEN. 5/14/70.
FORMF1: TLNE Z,NEOLF ;IF EOL ECHO SUPPRESSION IN EFFECT,
CALL NOECEO ;CHANGE CCOC SO EOL'S WON'T PRINT
JRST CCHR8
;PROCESS EOL
$EOL: TLNE Z,NEOLF ;EOL ECHOING SUPPRESSED?
TLO Z,EOLNEF ;YES, SAY THERE IS AN UNECHOED EOL.
JRST CCHR8
;PROCESS "-"
$DASH: TLNE Z,DASHF ;"DASHF" MAKES IT NON-ALPHANUMERIC, AND THUS
TRZ CBT,ALPHAN ;A TERMINATOR. USED IN "LIST" SUBCMD "PAGES".
JRST CCHR8
;PROCESS ↑V
$CTRLV: TLO Z,CTRLVF ;INDICATE PRECEDED BY ↑V
JRST CCHR1 ;GO GET ANOTHER CHARACTER
;PROCESS CONTINUATION CHARACTER (&)
$CONT: CALL DOECEO ;MAKE EOL'S PRINT
PRINT EOL ;ECHO EOL-SPACE
PRINT " "
MOVE CBT,CHRTBL+" " ;RETURN BITS FOR SPACE
MOVEI CHR,CONTCH ;STORE SPECIAL CHARACTER IN CBUF
JRST FORMF1 ;GO SUPPRESS EOL PRINTING IF FLAG ON & JRST CCHR8
;"CONTCH" IS USED BECAUSE MUST STORE A SINGLE BYTE BUT
;KNOW TO TRANSLATE IT TO 3 BYTES (&-EOL-SPACE) ON OUTPUT BY
;↑A OR ↑R.
;UBP CCHEOF CCHEF1 CCHEF2 CCHEF3 CCHEF4
;SUBROUTINE TO BACK UP ONE CHARACTER IN COMMAND STRING.
;UN-INCREMENTS "BFP" AND "CNT".
UBP: SOJ CNT,
ADD BFP,[7B5] ;UNCREMENT BYTE POINTER
TLNE BFP,40B23 ;THIS FAILS FOR POINTERS TO BIT -1
SUB BFP,[43B5+1] ;(SUCH POINTERS SHOULD NEVER GET HERE)
RET
;EOF WHILE READING COMMAND FILE
; THIS IS CALLED AT COMPUTE LEVEL, NOT PSI LEVEL
CCHEOF: INTOFF
GPJFN
HLRZM 2,CRJFNI
HRRZM 2,CRJFNO ;SAVE FOR * IN "RED" OR "DET" CMND
MOVE 2,PRIMRY ;REVERT TO JFNS WE HAD AT ENTRY
SPJFN
MOVEI 1,100
MOVEM 1,CIJFN
MOVEI 1,101
MOVEM 1,COJFN
CCHEF1: TYPE <[Eof on command input file]>
MOVE 1,CRJFNI
CAIE 1,-1 ;PREVIOUS INPUT WAS CONTROLLING TTY?
SKIPL CREDIF ;WAS INPUT REDIRECTED?
JRST CCHEF2 ;YES OR NO
CLOSF
CALL SCREWUP
CCHEF2: SETZM CREDIF ;SAY INPUT NOT NOW REDIRECTED
CCHEF3: MOVE 1,CRJFNO
CAIE 1,-1
SKIPL CREDOF
JRST CCHEF4
CLOSF
CALL SCREWUP
CCHEF4: SETZM CREDOF
INTON
CALL RLJFNS ;RELEASE JFN'S
JRST ERRET ;BACK TO MAIN LOOP (FOR NOW)
;%TYPE TYP1 TYP2 CTYPE %$TYPE $CTYPE %ALTYP
;SERVICE ROUTINE FOR OUTPUT STRING UUO ("TYPE" MACRO)
; UTYPE [ASCIZ @TEXT@]
;AND
;SUBROUTINE TO TYPE STRING FOR BYTE PTR IN A (CTYPE)
%TYPE: PUSH P,A ;UUO SERVICE ENTRY
HRR A,40
HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE POINTER TO ARGUMENT
TYP1: PUSH P,B
TYP2: ILDB B,A
JUMPE B,[POP P,B
POP P,A
RET]
CALL CCHRO ;OUTPUT CHARACTER IN B
JRST TYP2
CTYPE: PUSH P,A ;SUBR ENTRY
JRST TYP1
;SIMILAR BUT ALSO STORE TEXT IN COMMAND BUFFER.
;USE FOR NOISE WORDS & PRINTING REST ON ALT MODE, SO ↑R PRINTS IT ALL
%$TYPE: PUSH P,Z ;UUO ENTRY
TLO Z,STCF ;FLAG TELLS "CCHRO" TO STORE CHARACTERS
CALL %TYPE
POP P,Z ;RESTORE PREVIOUS STATE OF STCF
RET
$CTYPE: PUSH P,Z ;SUBROUTINE ENTRY
TLO Z,STCF
CALL CTYPE
POP P,Z
RET
;SIMILAR BUT ONLY DO IT IF TERMINATOR (IN AC "TRM") IS ALT MODE.
;USED TO TYPE REST OF RECOGNIZED WORD, SPACES BEFORE ARGUMENTS, ETC.
;MACRO "ALTYPE", UUO "UALTYP".
%ALTYP: CAIN TRM,ALTM
JRST %$TYPE
RET
;SEE ALSO "%ETYPE" IN S3.MAC
;COLLECT FILE NAMES:
;CINFN & COUTFN & SPECFN & CPFN & .INFG & INFG & DIRARG & SO ON.
;VARIOUS ENTRIES FOR INPUT, OUTPUT, SPECIAL CASE, & GROUP DESCRIPTORS.
;CAN INPUT LIST OF NAMES SEPARATED BY COMMAS AS WELL AS *.MAC FORMS.
;TAKE: A: RH: 0, 2, OR DEFAULT EXTENSION POINTER
; 2 => USE LAST NAME INPUT AS DEFAULT NAME
; LH: 0, -1, -2, 1, 2, OR DEFAULT NAME POINTER
; 0 => RETURN +1 IF NULL, PRINTING "-" ON ALT MODE
; 1 => LIKE 0 BUT ALSO RETURN +1 IF "*" INPUT
; 2 => LIKE -1 BUT USE EXT OF LAST FILE NAME INPUT AS
; DEFAULT EXT
; -1=> GIVE INPUT TO GTJFN EVEN IF NULL OR *
; -2 LIKE -1 BUT GIVE R1 IF NO SUCH FILE
; ALSO ENTRY "SPECFN" TAKES IN B: LH: DEFAULT VERSION (USUALLY 0)
; RH: FLAGS FOR GTJFN PLUS:
; B15: ALLOW GROUP OF NAMES, ALL BUT LAST TERMINATED WITH ",".
; DOES NOT HANDLE ALTMODE-COMMA (USE ↑F FOR RECOGNITION),
; MAY THUS BE USED WHERE A NOISE WORD, ETC FOLLOWS (COPY)
; B16 & B17 ARE HAIRY: THE CASUAL READER SHOULD DISREGARD
; THEM.
; B16: ALLOW GROUP OF NAMES SEPARATED BY SPACE, ALTMODE, OR
; SPACE-COMMA OR ALTMODE-COMMA. IF LAST COMMA IS FOLLOWED
; BY ALTMODE OR EOL, GIVE R1 (TO INDICATE SUBCOMMAND
; INPUT REQUIRED).
; B15 SHOULD ALSO BE ON.
; ONLY USEABLE IF LIST IS LAST THING IN COMMAND; CAN
; PRE-READ FOLLOWING FIELD HENCE WONT WORK WITH "CONFRC".
; B17: DEFAULTS NULL WITHOUT LETTING THE USER BE AWARE
; OF THIS (NO PRINTOUT, RETURN WITH BAKFF ON IF IT
; WAS ALT MODE).
; EG "DIRECTORY$$" AND "DIRECTORY$ *.*$$" ARE =.
; ALSO IF AT ENTRY PRECEDING FIELD ENDED IN COMMA OR EOL,
; BEHAVE AS THO THAT CHARACTER WERE INPUT HERE &
; DEFAULT ACCORDINGLY.
; EG "DIRECTORY,$", "DIRECTORY ,$" ARE SAME.
; B14: ALLOW * FOR NAME IN EMPTY DIRECTORY, RETURNING -2
; IN PLACE OF JFN.
; (NOT WORKING 2/9/71 CAUSE GJFX32 NOT WORKING.)
;
;
; ALSO, F3 IN Z SAYS TO DEFAULT DIRECTORIES TO CONNECT AND LOGIN
; AFTER INITIAL TRY FAILS -- FOR DEFAULT RUN
;COLLECT FILE NAMES COMMENTS...
;RETURN: +1: NULL INPUT AND 0 OR 1 IN LH OF A, OR "-" INPUT,
; OR "*" INPUT AND 1 IN LH OF A (INDICATED BY "*" IN A),
; OR TRM=EOL AT ENTRY (IN WHICH CASE NO INPUT),
; OR -2 IN LH OF A AND NO SUCH FILE,
; OR B16 ON AND LIST ENDED WITH COMMA.
; THE FIRST 3 OF THESE RETURN +1 OPTIONS SHOULDN'T
; BE USED IF B15, B16, OR B17 ON.
; +2: SUCCESS, JFN IN A AND ALSO STACKED IN BUFFER "JBUF"
; (POINTER JBUFP). 1ST LOCATION IN THIS BUFFER
; (FIRST JFN IN COMMAND) CAN BE ADDRESSED AS CJFN1,...
; IF AN INPUT GROUP DESCRIPTOR COULD HAVE BEEN INPUT
; (B11,15,16,OR 17 ON), SETS INIFH1 &2 TO 1ST & LAST USED
; LOCS IN JBUF, RETURNS FIRST JFN IN A, AND SETS "GROUPF"
; IF A GROUP WAS SPECIFIED (* OR MORE THAN 1 NAME INPUT).
; EITHER: TERMINATOR IN "TRM"
;ASSUME NULL INPUT IF LAST TERMINATOR=EOL AND BAKFF OFF,
; AS %KEYW DOES. SEE %KEYW'S GLITCH NOTE (S1.MAC).
;FLAGS IN AC D
;RH: FROM CALLER
;LH: B0: NULL INPUT UNDER B17 OPTION
; B1: B16 ON, ALREADY AT LEAST ONE ARG, NOT FOLLOWED BY COMMA
; B2: DITTO, DITTO, FOLLOWED BY COMMA
;COUTFN CINFN CEDFN
;COLLECT FILE NAMES... ENTRIES.
;OUTPUT FILE NAME ENTRY (OLD OR NEW NAME).
;PRINTS WHETHER OLD OR NEW, NO CONFIRMATION.
COUTFN: PUSH P,B
MOVEI B,440000 ;GTJFN FLAGS FOR OUTPUT FILE NAME
JRST CFN1
;INPUT (OLD FILE REQUIRED)
CINFN: PUSH P,B
MOVEI B,100000 ;FLAGS FOR GTJFN FOR INPUT FILE
JRST CFN1
;EDIT FILE NAME -- MAY OR MAY NOT EXIST YET
CEDFN: PUSH P,B
MOVE A,EDFILE ;POINTERS TO DEFAULT NAME AND EXT.
; MOVEI B,B3+B4 ;PRINT NEW/OLD, CONFIRM, NO SPEC OPTIONS
MOVEI B,120000
JRST CFN1
;THE NEXT FOUR ENTRIES INPUT AN INPUT FILE GROUP.
;ALL PERMIT *'S AND ADDITIONAL NAME AFTER ONE TERMINATED BY COMMA.
;NO SPECIAL RETURN FOR "*" OR NULL INPUT.
;THESE EXEMPLIFY USE OF GROUP FEATURES, OTHERS POSS USING "SPECFN".
;.INFG .INFG1 INFG $INFG DIRARG
;COLLECT FILE NAMES... GROUP ENTRIES
;.INFG
;ACCEPTS COMMAS ONLY IF THEY TERMINATE FILE NAME -
; THUS ↑F MUST BE USED FOR RECOGNITION IF COMMA IS TO FOLLOW.
;SUITABLE FOR USE WHERE ADDITIONAL FIELDS OF COMMAND FOLLOW,
; AS IN 1ST ARG TO "COPY".
;NAME AND EXT DEFAULT TO LAST INPUT (THUS NONE FOR 1ST IN GROUP),
; VERSION TO HIGHEST.
;ONE RETURN ONLY.
.INFG: PUSH P,B
MOVEI B,B2+B11+B15 ;GTJFN & LOCAL FLAGS: OLD FILES,
;*'S FOR INPUT, MINIMUM COMMA OPTION.
.INFG1: MOVE A,[XWD 2,2]
CALL SPECFN
JRST CERR
JRST [ POP P,B
RET]
;INFG
;SIMILAR BUT ALSO ALLOWS COMMAS AFTER ALTMODE OR SPACE AND
; ADDITIONAL NAMES WITHOUT COMMA AFTER ALTMODE OR SPACE.
;SUITABLE FOR USE ONLY AT END OF COMMAND, AS WITH "LIST".
;WARNING: CAN PRE-READ CONFIRMATION CHARACTER.
INFG: PUSH P,B
MOVEI B,B2+B11+B15+B16
JRST .INFG1
;$INFG
;SIMILAR TO ABOVE EXCEPT RETURNS +1 IF LIST ENDED WITH COMMA NOT
;FOLLOWED BY ANOTHER NAME (TO INDICATE SUCCOMMAND INPUT).
$INFG: PUSH P,B
MOVEI B,B2+B11+B15+B16
MOVE A,[XWD 2,2]
JRST CFN1
;DIRARG
;FANCIEST INPUT GROUP, LIKE ABOVE EXCEPT:
; DEFAULTS NAME, EXT, VERSION TO "*". ALLOWS DELETED FILE NAMES (UG!).
; IF PRECEDING FIELD ENDED WITH COMMA OR EOL, OR IF A NULL ARG IS
; SEEN, SUPPLIES DEFAULT ARG "*.*;*" BUT HIDES THIS FROM USER.
; ACCEPTS * FOR NAME IN EMPTY DIRECTORY
DIRARG: PUSH P,B
MOVE A,[XWD [ASCIZ /*/],[ASCIZ /*/]]
HRLI B,-3 ;DEFAULT VERSION: *
HRRI B,B2+B8+B11+B14+B15+B16+B17
JRST CFN1
;SPECFN CFN1 CFN1A CFN1B
;COLLECT FILE NAMES ENTRIES...
;ENTRY FOR GTJFN FLAGS IN RH OF B, DEFAULT VERSION (NORMALLY 0) IN LH.
; USED IN SPECIAL CASES, EG:
; DEFAULT TO LOWEST VERSION FOR "DELETE" (-2 IN LH B)
; DELETED FILE NAME FOR "UNDELETE"
; NEW NAME FOR "DEFINE"
; ANYWHERE *'S ARE ALLOWED, AS IN "DIRECTORY".
SPECFN: PUSH P,B
;END OF ENTRIES. CASES MERGE HERE.
CFN1: SETZM CJFNBK+3 ;NO DEFAULT DIRECTORY
CFN1A: PUSH P,C ;"CPFN" SETS DEFAULT DIR AND JOINS HERE.
PUSH P,D
HRRZ D,B ;SAVE GTJFN AND LOCAL FLAGS IN RH D
;NOTE: B0 OF LH D USED AS A FLAG IN CONJUNCTION WITH
;NULL INPUT UNDER B17 OPTION
TRZ B,B15+B16+B17 ;DON'T GIVE LOCAL FLAGS TO GTJFN
TRNE D,B11+B15+B16+B17 ;IF AN INPUT GROUP IS BEING REQUESTED,
SETZM INIFH1 ;SAY NO NAMES HAVE BEEN INPUT YET.
TRNE D,B17
TRNN CBT,TCOM+TEOL
JRST CFN1B
TLOE Z,BAKFF
JRST CFN1B
;B17 OPTION ON AND LAST FIELD ENDED IN COMMA OR EOL.
;BEHAVE AS THO FIRST INPUT FIELD WAS JUST THAT CHARACTER
MOVE .BFP,BFP
CALL UBP ;UNINCREMENT BFP
EXCH .BFP,BFP ;SET UP PTRS TO TERMINATOR ONLY
MOVEI CNT,1 ;NULL FIELD. BAKFF ALREADY ON.
MOVEI C," "
TRNE CBT,TEOL ;CHANGE EOL TO SPACE SO GTJFN WON'T
DPB C,BFP ;"ECHO" EXTRA CR
CFN1B: TLNE Z,BAKFF ;IF THERE'S AN UNUSED FIELD,
JRST .+3 ;THEN THE COMMAND HASN'T ENDED.
TRNE CBT,TEOL ;LAST TERMINATOR CR OR ; ?
JRST CFN9 ;YES, IT ENDED COMMAND, NO MORE INPUT
;CFN2
;COLLECT FILE NAMES...
;SET UP GTJFN PARAMETER BLOCK
MOVSM B,CJFNBK ;FLAGS AND DEFAULT VERSION
MOVE B,COJFN
HRL B,CIJFN
MOVEM B,CJFNBK+1 ;XWD INPUT JFN, OUTPUT JFN
;COME BACK HERE TO GET ANOTHER FILE NAME IN GROUP
CFN2: TLZ D,B0
; FORM "DEFAULT STRING POINTER" TO EXTENSION
HRRZ B,A
HRLZI C,B11 ;ARGUMENT FOR LFJFNS: EXT ONLY, NO PUNCT
CAIN B,2 ;2 SAYS USE EXT OF LAST FILE NAME INPUT
CALL LFJFNS ;GET A STRING FOR LAST FILE'S EXT
JUMPE B,.+2
HRLI B,<POINT 7,0,-1>B53
MOVEM B,CJFNBK+5
; FORM "DEFAULT STRING POINTER" TO DEFAULT NAME
HLRZ B,A
HRLZI C,B8 ;ARGUMENT FOR LJFNS: NAME ONLY, NO PUNCT
CAIN B,2 ;2 SAYS USE NAME OF LAST FILE NAME INPUT
CALL LFJFNS ;GET A STRING FOR LAST FILE'S NAME
CAIE B,-2
CAIN B,-1
SETZ B,
JUMPE B,.+2
HRLI B,<POINT 7,0,-1>B53
MOVEM B,CJFNBK+4
;CFN3 CFN3A CFN3B
;COLLECT FILE NAMES...
;NOW WE MUST READ TEXT UP TO A FILE NAME FIELD TERMINATOR,
; TO ALLOW EDITING, THEN CHECK FOR SPECIAL CASES: NULL, "-", AND "*".
;RETURN HERE TO RETRY AFTER ERROR RETURN FROM GTJFN.
CFN3: TLO Z,PUNCF+NEOLF ;SAY READ INPUT TO FILE FIELD TERMINATOR
;AND DON'T ECHO EOL (BECAUSE GTJFN PRINTS EOL
;WHEN APPROPRIATE EVEN IF IT WAS PRE-READ).
INHELP <File name> ;INPUT FIELD, TYPE MESSAGE ON "?"
TRNN CBT,TSPC+TALT+TEOL+TCOM
JRST CFN4 ;END OF FIELD, NOT WHOLE NAME, NOT SPEC CASE
CAIE CNT,1
JRST CFN3B
;NULL CASE
;NULL INPUT TERMINATING LIST UNDER B16 OPTION IS PROCESSED
;HERE RATHER THAN AFTER GTJFN FOR CORRECT BEHAVIOR AFTER ERROR:
;IE BAD FILE NAME TYPES "?", THEN IF JUST A CR IS INPUT,
;PRECEDING LIST IS PROCESSED AS THO IT WAS TERMINATED BY THE CR.
TRNN CBT,TALT+TEOL
JRST .+5 ;ANOTHER COMMA DOESN'T END LIST
TLNE D,B2 ;B16 & PREV FIELD ENDED WITH COMMA?
SOSA -3(P) ;YES, CANCEL AOS BELOW TO GIVE R1 AFTER
;GOING THRU GOOD RETURN CODE
TLNE D,B1 ;B16 & NO COMMA AFTER PREV ARG?
JRST [ PUSH P,A ;YES. INTERFACE TO EXIT CODE AT "CFN7Z"
CAIN TRM,ALTM ;.. DON'T BUFFER ALT MODES, CAUSE
CALL UBP ;.. OTHERWISE "ALTYPE ( )" SETS CNT TO
; 2 AND "CONF" GIVES AN ERROR.
TLO Z,BAKFF ;RE-USE ALTM OR EOL AS CONFIRMING CHAR
JRST CFN7Z]
TRNE D,B17 ;B17 OPTION (SEE COMMENTS AT BEGINNING)
TRNN CBT,TALT ;YES, NULL ONLY SPECIAL IF ALTMODE
JRST CFN3A
MOVEI B," "
DPB B,BFP ;SUPPRESS PRINTOUT OF DEFAULT
TLO D,B0 ;INVOKE ADDL SPECIAL STUFF AFTER GTJFN
JRST CFN4
CFN3A: TLNE A,-2 ;DID CALLER GIVE A DEFAULT NAME,
;OR -1 TO SAY "NO SPEC CASE FOR NULL"?
JRST CFN4 ;YES, GO GTJFN
UALTYP [ASCIZ /-/] ;NO. PRINT "-" IF ALT MODE.
JRST CFN9 ;RETURN +1
CFN3B: CAIN CNT,2
;ONE-CHARACTER CASE
JRST [ MOVE B,.BFP ;GET THE ONE CHARACTER
ILDB B,B ;...
CAIN B,"-" ;WAS IT "-"?
JRST CFN9 ;YES, RETURN +1.
CAIE B,"*" ;WAS IT ASTERISK?
JRST .+1 ;NO, NOT SPECIAL, GO GTJFN.
HLRZ B,A ;YES, DID CALLER REQUEST SPECIAL
CAIE B,1 ;...HANLDING OF ASTERISK?
JRST .+1 ;NO.
MOVEI A,"*" ;YES, RETURN +1 WITH "*" IN A.
JRST CFN9]
;CFN4 CFN4X CFN4Y CFN4Z
;COLLECT FILE NAMES...
;HERE WHEN EXCEPTIONS ELIMINATED AND MUST "GTJFN"
CFN4: PUSH P,A ;SAVE FOR ERROR RETRY
HLRZ B,JBUFP ;CHECK SPACE IN JFN BUFFER
CAIN B,-1
ERROR <Too many JFN's in command>
MOVEI A,CJFNBK ;GTJFN PARAMETER BLOCK LOCATION
MOVE B,.BFP ;POINTER TO STRING INCLUDING TERMINATOR
GTJFN ;GET JFN FOR NAME. TAKES MORE INPUT FROM
; COMMAND FILE (TTY) IF NEEDED.
CAIA ;1: FAILLED: TRY F3
JRST CFN4Z ;SUCCESS
TLNN Z,F3 ;IF F3, THEN TRY AGAIN USING
; FIRST THE CONNECTED DIRECTORY
; AND NEXT THE LOGIN DIRECTORY
; USED FOR SUBSYSTEM NAME COMMAND
; IF STILL FAILS OR IF NOT F3
; THEN CALL CFNE TO ADJUST PC FOR JERR
JRST CFN4Y
PUSH P,D
GJINF ;GET CONNECTED DIRECTORY
POP P,D
CAMN 1,2 ;EQUALS LOGIN DIRECTORY?
JRST CFN4X ;YES
HRROI A,IUSRNM ;GET DIRECTORY STRING
DIRST
CALL [ SKIPG CUSRNO ;LOGGED-IN?
JRST CERR
JRST SCREWUP] ;YES, REAL SCREWUP
MOVEI A,CJFNBK ;LONG GTJFN BLOCK
HRROI B,IUSRNM ;NEW DEFAULT DIRECTORY
MOVEM B,3(A)
MOVE B,.BFP ;STRING POINTER FOR INPUT SO FAR
GTJFN
CAIA ;FAILED AGAIN, TRY LOGIN DIRECTORY
JRST CFN4Z ;SUCCESS
PUSH P,D
GJINF
POP P,D
CFN4X: MOVE B,A
HRROI A,IUSRNM
DIRST ;GET DIRECTORY STRING
CALL [ SKIPG CUSRNO
JRST CERR
JRST SCREWUP]
MOVEI A,CJFNBK ;LONG GTJFN BLOCK
HRROI B,IUSRNM ;NEW DEFAULT DIRECTORY
MOVEM B,3(A)
MOVE B,.BFP ;INPUT STRING SO FAR
GTJFN ;TRY AGAIN
CFN4Y: CALL CFNE ;ADJUST PC FOR JERR
CFN4Z: MOVE B,JBUFP ;ADD JFN TO STACK. MUST HAPPEN PROMPTLY
PUSH B,A ;SO IT WILL GET RELEASED ON ERRORS.
MOVEM B,JBUFP
;PUT FILE NAME TEXT (UNFORTUNATELY NOT NECESSARILY AS INPUT)
; INTO COMMAND STRING BUFFER, FOR ↑R.
MOVE B,A ;JFN
MOVE A,.BFP ;DEST: OVERWRITE WHAT WAS PRE-READ
SETZ C, ;DEFAULT FORMAT
CAME B,[-2] ;NULL TEXT FOR EMPTY DIRECTORY
JFNS ;JFN TO STRING CONVERSION
MOVE BFP,A ;NEW END OF COMMAND STRING
CALL INTRM ;GET TERMINATING CHR OF FIELD GTJFN READ
MOVE A,B ;JFN TO A TO RETURN
;CFN7A CFN7B
;COLLECT FILE NAMES...
;CODE FOR THE VARIOUS GROUP CASES
TRNN D,B11+B15+B16+B17
JRST CFN8 ;NO SUCH OPTIONS ON
TLZE D,B1+B2 ;B16 AND NOT FIRST ARG?
TLO Z,GROUPF ;YES, SAY GROUP INPUT.
HRRZ B,JBUFP
SKIPN INIFH1 ;FIRST JFN IN GROUP?
MOVEM B,INIFH1 ;YES, SAVE JBUF POINTER
TLNE A,<77B5>B53 ;ANY *'S INPUT OR DEFAULTED TO?
TLO Z,GROUPF ;YES, SAY GROUP WAS SPECIFIED.
TLNN D,B0 ;WAS IT ALTMODE ONLY & B17 OPTION ON?
JRST CFN7A ;NO
;AFTER ALTMODE TO B17 OPTION RETURN IMMEDIATELY
;WITH BAKFF ON SO THE ALT MODE FUNCTIONS AS CONFIRMATION CHAR
TLO Z,BAKFF
JRST CFN7Z
CFN7A: TRNE D,B15
CAIE TRM,","
JRST CFN7C
;COMMA TERMINATOR AND B15 ON
HLRZ A,JBUFP ;JFN LIST PUSH POINTER
CAIN A,-2
JRST [ UTYPE [ASCIZ /[File list full]/]
MOVEI 1,↑D500
DISMS
MOVEI 1,100
CFIBF
MOVEI TRM,33 ;FAKE ALTMODE AS TERMINATOR
MOVEI CBT,TALT
JRST CFN7Z] ;AND GET OUT
TRNE D,B16
JRST CFN7D
;GO GET NEXT ARGUMENT OF LIST
TLO Z,GROUPF ;SAY A GROUP HAS BEEN INPUT
CFN7B: POP P,A ;RESTORE CALLER'S A
JRST CFN2 ;GO RESETUP DEFAULTS AND READ ANOTHER ARG
;CFN7C CFN7D CFN7Z
;COLLECT FILE NAMES... GROUP CASES CODE...
CFN7C: TRNE CBT,TALT+TSPC
TRNN D,B16
JRST CFN7Z
;ALTMODE OR SPACE TERMINATOR AND B16 ON.
;PREREAD NEXT FIELD AND CHECK FOR COMMA.
ALTYPE ( )
HLRZ A,JBUFP ;FILE LIST PUSH POINTER
CAIN A,-2
JRST [ UTYPE [ASCIZ /[File list full]/]
MOVEI 1,↑D500
DISMS
MOVEI 1,100
CFIBF
JRST CFN7Z]
TLO Z,NEOLF
CALL CSTR
CAIE CNT,1
JRST .+3 ;NON-NULL, ITS ANOTHER ARG
TRNE CBT,TCOM
JRST CFN7D ;NULL, COMMA, IS SEPARATOR, DONT REUSE
TLO Z,BAKFF ;SAY RE-USE FIELD
TLOA D,B1 ;SAY B16 AND NO COMMA & GET NEXT ARG
;B16 ON AND COMMA SEEN.
CFN7D: TLO D,B2 ;SAY B16 AND COMMA SEEN
JRST CFN7B ;GO GET NEXT ARG OR TERMINATE LIST ON NULL
CFN7Z: HRRZ B,JBUFP
MOVEM B,INIFH2 ;RETURN JBUFP VALUE FOR LAST NAME IN GROUP
MOVE A,@INIFH1 ;RETURN FIRST, NOT LAST, JFN IN A
;CFN8 CFN9 CFN9A
;COLLECT FILE NAMES...
;END OF GROUP CASES CODE. RETURN.
CFN8: POP P,B ;THROW AWAY JUNK. JFN TO RETURN IS IN A
AOS -3(P) ;+2
CFN9: TLZE Z,EOLNEF ;IF THERE'S UNECHOED EOL,
JRST [ MOVE B,CJFNBK ;GET GTJFN BITS
TLNN B,(1B3) ;WAS CONFIRMATION MESSAGE PRINTED?
PRINT EOL ;NO, ECHO EOL NOW
JRST CFN9A]
ALTYPE ( ) ;TYPE SPACE IF IT ENDED WITH ALT MODE
CFN9A: POP P,D
POP P,C
POP P,B ;+1
RET
;CFNE
;COLLECT FILE NAMES...
;GTJFN ERROR RETURN PUSHJ'S HERE WITH ERROR CODE IN A.
;MOST ERRORS ARE FILE NOT FOUND OR SELF-EVIDENT SYNTAX ERRORS.
; FOR THOSE TYPE " ? " AND REPEAT GTJFN.
;FIRST TEST ERROR CODE FOR EXCEPTIONS.
CFNE: CAIN A,GJFX3
ERROR <No JFN's available: you must close some files first>
CAIN A,GJFX22
ERROR <JSB full: try closing some files then repeating command>
CAIN A,GJFX23
ERROR <Directory full: can't create new files until you
DELETE some files and EXPUNGE>
CAIN A,GJFX27
ERROR <New file name required>
CAIN A,GJFX28
ERROR <Device not mounted>
CAIN A,GJFX29
ERROR <Device assigned to another job>
CAIN A,GJFX31
ERROR <Bad use of *>
CAIN A,GJFX32
JRST [ ;IF FLAG B14 ON GIVE GOOD RETURN WITH -2 INSTEAD
;OF JFN WHEN GJFX32 ERROR OCCURS.
;USED FOR "DIRECTORY" (DIRARG).
TRNN D,B14
UERR [ASCIZ /No files in that directory/]
HRROI A,-2
RET] ;RETURNS TO LOC(GTJFN) +2
SUB P,[XWD 1,1] ;DISCARD PC SAVED FOR JERR (NOT USED 6/29/70)
TLZ Z,EOLNEF ;DON'T ECHO ANY "UNECHOED" EOL (GTJFN DID IT)
PUSH P,.BFP
CALL INTRM ;GET TERMINATOR
HLRZ A,-1(P) ;MOST GTJFN ERRORS RETURN +1 IF CALLER GAVE
CAIN A,-2 ;... -2 IN LH OF A.
JRST [ POP P,.BFP ;(THIS FEATURE USED ONLY FOR
POP P,A ; CPFN. 4/30/70)
JRST CFN9] ;RETURN +1.
TRNE CBT,TEOL
JRST CERR ;NO RETRY AFTER CARRIAGE RETURN
TYPE < ? >;
MOVEI 1,↑D500
DISMS
MOVEI 1,100
CFIBF
POP P,BFP ;OLD .BFP VALUE: CLEAR NAME FROM BUFFER
POP P,A
BTCHER ;STOP NON-CONVERSATIONAL JOB
JRST CFN3
;INTRM
;INTRM
;GET TERMINATOR AFTER GTJFN, ETC, BY RE-READING CHARACTER.
INTRM: PUSH P,A
MOVE A,CIJFN
BKJFN ;"UN-INPUT" IT
CALL JERR
POP P,A
MOVE .BFP,BFP ;INITIALIZE FIELD TO PREVENT EDITING
SETZ CNT, ;(PROBABLY UNNECESSARY)
CALL CCHRI ;READ CHARACTER
CAIN CHR,ALTM
CALL UBP ;DON'T BUFFER ALT MODES
MOVE TRM,CHR
RET
;LFJFNS LFJF9
;LFJFNS: SUBROUTINE FOR CINFN, COUTFN, SPECFN.
;DO A JFNS FOR MUST RECENT PREVIOUSLY INPUT FILE NAME, USING
; JFNS FORMAT SPECIFICATION IN C.
;RETURNS IN B: POINTER TO LEFT-ADJUSTED STRING
;IF LAST JFN NOT ON A DIRECTORY DEVICE, OR NO PREVIOUS JFN FOR THIS
; COMMAND, RETURNS 0 IN B.
LFJFNS: PUSH P,A
HRRZ B,JBUFP ;JFN STACK POINTER
CAIN B,JBUF-1 ;HAS A NAME BEEN INPUT YET?
JRST LFJF9 ;NO, GO RETURN 0 POINTER
HRRZ A,(B) ;PICK UP JFN OF LAST NAME INPUT
CAIN A,-1
JRST LFJF9 ;-1 ISN'T A JFN BUT MIGHT GET HERE
PUSH P,C
DVCHR ;GET DEVICE CHARACTERISTICS FOR JFN
POP P,C
TLNN B,B2
JRST LFJF9 ;NOT A DIRECTORY DEVICE, RETURN 0
HRRZ A,CSBUFP ;STRING BUFFER POINTER RH
ADD A,[POINT 7,1,-1] ;BEGINNING OF NEXT WORD
MOVEM A,CSBUFP
MOVE B,JBUFP
MOVE B,(B) ;PICK UP JFN AGAIN
JFNS ;DO THE JFN TO STRING CONVERSION
SETZ B,
IDPB B,A ;APPEND NULL TO STRING
EXCH A,CSBUFP ;UPDATE BUFFER PTR, GET STRING BEGINNING
SKIPA B,A ;RETURN STRING POINTER IN B
LFJF9: SETZ B, ;RETURN 0 IF CAN'T RETURN A STRING
POP P,A
RET
;CPFN
;CPFN: COLLECT PROGRAM FILE NAME
;TAKES: A: 0 OR WORD POINTER TO DEFAULT DIRECTORY NAME.
;NO DEFAULT NAME, DEFAULT EXTENSION ALWAYS ".SAV".
;RETURNS +1 ON GTJFN FAILURE.
CPFN: PUSH P,B
MOVEI B,100000
JUMPE A,.+2
HRLI A,<POINT 7,0,-1>B53 ;IF NON-0, FILL OUT BYTE PTR
MOVEM A,CJFNBK+3 ;DEFAULT DIRECTORY
HRRI A,[ASCIZ /SAV/] ;DEFAULT EXT
HRLI A,-2 ;SAY RETURN +1 ON GTJFN FAILURE
JRST CFN1A ;JOIN CINFN & COUTFN
;TYPIF GNFIL GNFIL3 GNFIL5 GNFIL8
;TYPIF: TYPE NAME OF CURRENT FILE IN INPUT FILE GROUP
; BUT NOT IF NOT A GROUP (IE ONLY ONE NAME AND NO *'S INPUT)
;RETURNS JFN IN A
TYPIF: HRRZ A,@INIFH1 ;GET CURRENT JFN
TLNE Z,GROUPF ;SKIP IF NON-GROUP
ETYPE < %1S
>; ;%S: TYPE NAME FOR JFN
RET
;GNFIL
;GET NEXT INPUT FILE OF GROUP WHICH MAY CONTAIN *'S OR MULTIPLE NAMES.
;R1 IF NO MORE FILES. R2 WITH NEXT JFN IN A.
;CLOSES PREVIOUS FILE IF OPEN. DOESN'T RELEASE JFN (RLFJNS DOES THIS).
GNFIL: PUSH P,A
PUSH P,B
HRRZ A,@INIFH1
GTSTS
JUMPGE B,GNFIL3 ;JUMP IF NOT OPEN
TLO A,B0 ;SAY DON'T RELEASE JFN
CLOSF
CALL JERR
GNFIL3: MOVE A,@INIFH1
TLNN A,<77B5>B53 ;NO *-FLAGS, SKIP GNJFN AND ITS BUGS
JRST GNFIL5
CAME A,[-2] ;-2 MEANS "NO FILES AT ALL" IN CERTAIN CASES
;(THAT SHOULDN'T GET HERE ANYWAY)
GNJFN ;STEP TO NEXT FILE IN *-GROUP
JRST GNFIL5 ;NO MORE
JRST GNFIL8
GNFIL5: AOS A,INIFH1 ;NEXT NAME IN GROUP
CAMLE A,INIFH2 ;ARE THERE MORE?
JRST [ POP P,B ;NO
POP P,A
RET]
GNFIL8: HRRZ A,@INIFH1 ;RETURN NEXT JFN IN A
AOS -2(P)
POP P,B
SUB P,[XWD 1,1]
RET
;FRSTF FRSTF1 NEXTF
;FRSTF AND NEXTF: ROUTINES FOR STANDARD USE OF INPUT FILE GROUP.
;CALL FRSTF BEFORE PROCESSING A FILE.
; IT TYPES NAME IF A GROUP IS BEING PROCESSED.
;AFTER PROCESSING FILE, JRST NEXTF.
; IF NO MORE FILES IN GROUP, GOES TO RLJFNS WHICH RETURNS TO COMMAND
; INPUT OR ANY OTHER ADDRESS WHICH HAS BEEN PUSHED.
; OTHERWISE, GETS HEXT JFN IN A, TYPES NEXT FILE NAME, AND RETURNS
; WHERE FRSTF LAST RETURNED. BEWARE OF PD LEVEL CHANGES!
FRSTF: POP P,FRSTFR ;SAVE RETURN FOR CALLS TO NEXTF
FRSTF1: CALL TYPIF ;TYPE FILE NAME IF GROUP
PUSH P,FRSTFR ;RETURN
RET
NEXTF: CALL GNFIL ;NEXT FILE IN GROUP
JRST RLJFNS ;R1: NO MORE. FAILS IF GARBAGE IN PD!
JRST FRSTF1
;DEVN DEVN1 DEVNE
;DEVN
;INPUT AND VERIFY A DEVICE NAME.
;READS STRING, ACCEPTING ALT MODE (ECHO COLON), EOL, SPACE, COLON, SEMI
; AS TERMINATOR.
;DOES NOT DISTINGUISH PHYSICAL NAMES AND ALREADY-DEFINED SYNONYMS.
;RETURNS:
; A: DEVICE DESIGNATOR
; B: CHARACTERISTICS WORD AS RETURNED BY "DVCHR". HIGHLIGHTS THEREOF:
; B5: ON IF AVAILABLE OR ASSIGNED TO THIS JOB
; B6: ON IF ASSIGNED
; BOTH B5 & B6 ON IF ASSIGNED TO SELF
; C: JOB # ASSIGNED TO IF B6 OF B ON
;ENTRY
DEVN:
;RETURN HERE TO TRY AGAIN AFDER TYPING " ? " AFTER ERROR.
DEVN1: TLO Z,PUNCF
INHELP <Device name>
ALLOW TALT+TEOL+TSPC+TCOL
PUSH P,CSBUFP ;SAVE POINTER INTO SPACE "BUFFF" USES
CALL BUFFF ;BUFFER IT WITH NULL TERMINATOR, RET PTR IN A
STDEV ;STRING TO DEVICE DESIG CONVERSION
JRST DEVNE
;DESIGNATOR NOW IN B
;NEED WE CHECK FOR WHOLE STRING USED?
POP P,CSBUFP ;RECLAIM SPACE IN BUFFER USED BY "BUFFF"
CAIN TRM,ALTM
CALL UBP ;REMOVE ALT MODE FROM COMMAND STRING BUFFER
ALTYPE <: >
MOVE A,B
DVCHR ;GET CHARACTERISTICS WORD
HLRE C,C
RET
;ERROR RETURN FROM "STDEV".
DEVNE: POP P,CSBUFP ;RECLAIM SPACE IN STRING BUFFER USED BY "BUFFF"
MOVE A,B ;MOVE ERROR CODE TO 1
CAIE A,STDVX1 ;"UNRECOGNIZED DEVICE"
CALL JERR ;(4/13/70: NO ERRORS BUT STDVX1)
TRNE CBT,TEOL
JRST CERR ;AFTER CR, ABORT COMMAND.
TYPE < ? >; ;OTHER TERMINATORS: " ? " AND RETRY.
MOVE BFP,.BFP ;BACK UP PTR INTO COMMAND BUFFER
BTCHER
JRST DEVN1 ;TRY AGAIN
;DIRNAM DIRNAX
;DIRNAM
;INPUT A DIRECTORY (INCLUDES USER) NAME, WITH RECOGINITION.
;RETURNS ENTIRE WORD FROM STDIR IN A, PTR TO BUFFERED STRING IN B.
;USED IN CONNECT, WHERE, ↑EPRINT COMMANDS.
;PRESERVES E (FOR DIRECTORY).
DIRNAM: PUSH P,C
TLO Z,PUNCF
INHELP <Directory name>;READ NAME (REMEMBER "MORE" RETURNS HERE)
;CALLER MUST CHECK TERMINATOR
CALL BUFFF
PUSH P,A ;SAVE TO BE RETURNED
CAIN TRM,ALTM
CALL UBP ;REMOVE ALT MODE FROM BUFFER
MOVE B,A
MOVEI A,1 ;SAYS NO RECOG
TRNE CBT,TALT
TLO A,400000 ;ALT MODE: REQUEST RECOGNITION
STDIR
JRST CERR
JRST [ TRNN CBT,TALT ;AMBIGUOUS
JRST CERR
CALL DING
SUB P,[1,,1] ;FLUSH JUNK
JRST MORE]
PUSH P,A ;SAVE WHAT STDIR RETURNED
TRNN CBT,TALT ;DID STDIR RETURN UPDATED PTR?
JRST DIRNAX ;CSBUFP IS OK
IBP B
EXCH B,CSBUFP ;UPDATE STRING POINTER
MOVE A,B
BKJFN ;DECREMENT OLD BYTE PTR
CALL JERR ;...TO GET TO APPENDED CHARS (OR NULL IF NONE).
CALL $CTYPE ;ECHO AND BUFFER REST AFTER ALT MODE
DIRNAX: POP P,A ;DIR # AND BITS FROM STDIR
;ALTYPE ( ) OR ALTYPE (>) MUST FOLLOW IN CALLING ROUTINE
POP P,B
POP P,C
RET
;TTYNUM TTYN1 TTYN2 TTYN3 TTYN4 TTYN5 TTYN6 TTYN7 TTYN8 TTYN9 TTYN10 TTYN11
;INPUT A TTY NUMBER.
; MAYBE FROM USER NAME
; USED BY LINK, ADVISE
TTYNUM: INHELP <One of the following:
Terminal number
User name>
ALLOW TEOL+TSPC+TALT
CALL BUFFF
MOVEM P,FRAME ;SAVE BEGINNING OF POSSIBITITES
MOVE B,.BFP ;GET 1ST CHAR
ILDB A,B
MOVE C,CHRTBL(A)
TRNE C,OCTDIG
JRST TTYN10 ;TAKE AS TTY#
TTYN1: TLO Z,BAKFF ;REUSE FIELD
CALL DIRNAM ;INPUT AS USER NAME
TLNE A,B0
JRST CERR ;CAN'T LINK TO FILES ONLY DIR.
ALTYPE ( )
ALLOW TEOL+TSPC+TALT
CONFIRM
MOVEM A,DIRNO
TTYN2: MOVEM P,FRAME ;SAVE BEG OF ARGS
MOVE A,['JOBDIR']
CALL $SYSGT
HLLZ D,B ;MAKE AOBJN PTR
MOVEI E,0(B)
TTYN3: GTB 0(E)
XOR A,DIRNO
MOVEI A,(A)
JUMPN A,TTYN6 ;WRONG GUY
HRLZ A,D
GETAB
CALL JERR
MOVEI B,0(D)
JUMPE B,TTYN6 ;IGNORE JOB0
JUMPL A,TTYN6 ;AND DETACHED JOBS
HLRZS A
PUSH P,A ;SAVE TTY# (1ST WORD OF A POSSIBILITY)
TTYN4: MOVE A,['JOBNAM']
CALL $SYSGT
SKIPN A,B
JRST TTYN5
HRL A,D
GETAB
CALL JERR
MOVE C,A
MOVE A,['SNAMES']
CALL $SYSGT
SKIPN A,B
JRST TTYN5
HRL A,C
GETAB
CALL JERR
TTYN5: PUSH P,A ;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
TTYN6: AOBJN D,TTYN3 ;MAY HAVE MORE JOBS
CAMN P,FRAME ;FOUND ANY?
ERROR <Not logged in>
POP P,A ;SUBSYSTEM NAME
POP P,B ;TTY#
CAMN P,FRAME ;ONLY ONE POSSIBILITY?
JRST [ MOVE A,B ;YES, USE IT
JRST TTYN11]
TTYN7: MOVE C,B ;SAVE FOR POSSIBLE DEFAULT
ETYPE < TTY%2O%, >
JUMPE A,[PRINT "?" ;NO SUBSYS NAME
JRST TTYN8]
CALL SIXPRT ;PRINT SUBSYSTEM
TTYN8: PRINT EOL
CAMN P,FRAME ;DONE ALL?
JRST TTYN9 ;YES
POP P,A
POP P,B
JRST TTYN7
TTYN9: $TYPE < TTY: >
INHELP <Number>
ALLOW TEOL+TSPC+TALT
CAIN CNT,2
JRST [ MOVE B,.BFP ;ASKED FOR DEFAULT?
ILDB B,B
CAIE B,"-"
JRST .+1
MOVE A,C ;NULL INPUT. USE FIRST JOB SEEN
JRST TTYN11]
TTYN10: TLO Z,BAKFF ;REUSE FIELD
CALL OCTAL ;GOBBLE AS OCTAL NUMBER
JRST [ ALTYPE <->
MOVE A,C
JRST .+1]
CONFIRM
TTYN11: MOVE P,FRAME ;FLUSH BACK THE STACK
PUSH P,A ;SAVE TTY#
MOVE A,['TTYJOB']
CALL $SYSGT
CALL [ JUMPE B,JERR
RET]
HLRES B
MOVMS B
POP P,A ;TTY#
CAIGE A,0(B)
CAIGE A,0
ERROR <Non-existent terminal number>
RET
;DATEIN
;DATE AND TIME INPUT
;KWV1 MUST BE SET UP FOR "CONF" (0 OK). CLOBBERS A,B.
;DATE STRING IS PRE-READ BY EXEC (BECAUSE OF NOISE AND EDITING);
;IF DATE CONTAINS IMBEDDED SPACES, SEVERAL TRIES MAY BE NEEDED TO
;GET ENOUGH CHARACTERS.
DATEIN: TLO Z,PUNCF
CALL CSTR
AOS CNT ;MAKES BUFFF INCLUDE TERMINATOR
CALL BUFFF
SOS CNT
SETZ B, ;FORMAT: NORMAL, FULLY GENERAL
IDTIM ;INPUT AND CONVERT DATE AND TIME
CALL [ ;IDTIM ERR RETURN: CODE IN B, STRING PTR IN A.
EXCH A,B ;ERR CODE TO A (FOR JERR), STR PTR TO B
;IF IT INPUT THE NULL, THEN IT NEEDS MORE CHARACTERS.
CAIE A,DILFX1 ;"ILLEGAL DATE FORMAT" ?
CAIN A,TILFX1 ;"ILLEGAL TIME FORMAT" ?
JRST [ LDB B,B ;YES, GET LAST CHARACTER INPUT
JUMPE B,[SUB P,[XWD 1,1]
JRST MORE] ;GO BACK TO CSTR FOR MORE CHARS
JRST CERR] ;ILLEG FORMAT B4 USING ALL CHARS
CAIE A,DATEX3 ;BAD DAY OF MONTH (EG FEB 30)
CAIN A,DATEX5 ;OUT OF RANGE (EARLY 1858 OR LATE 2576)
JRST CERR ;"?"
JRST JERR] ;GENERAL JSYS ERROR RETURN ROUTINE
IBP A ;STEP STRING POINTER PAST THE NULL
CAME A,CSBUFP ;ENTIRE STRING USED BY IDTIM?
JRST CERR ;NO, TRAILING GARBAGE, ERROR.
ALLOW TSPC+TALT+TEOL
CONFIRM ;CHECK TERMINATOR, INPUT CR IF NECESSARY
MOVE A,B ;DATE & TIME IN INTERNAL FORMAT
RET
;DECIN BIGOCT BIGOC1 INCON1 OCTAL2 OCTAL3 OCTAL7 OCTAL
;"OCTAL": 18-BIT OCTAL NUMBER INPUT AND CONVERSION
;"BIGOCT": 36-BIT OCTAL (NOT EXTERNALLY USED 6/9/70)
;"DECIN": 36-BIT DECIMAL MAGNITUDE
;ALL RETURN VALUE IN A, TERMINATING CHARACTER IN "TRM".
;NO SKIP IF NULL INPUT.
;ERROR IF NON-DIGIT NON-TERMINATOR SEEN, OR IF OVERFLOW.
;ALLOWS ANY NON-ALPHNUMERIC AS TERMINATOR. CALLER MUST CHECK!
;DO NOT MAKE THIS A MONITOR FUNCTION BECAUSE OF DIFFICULTY OF
; CAPTURING EXACT INPUT STRING FOR ↑R.
DECIN: PUSH P,F ;ENTRY FOR 36-BIT DECIMAL MAGNITUDE
INHELP <number>
MOVEI F,↑D10
JRST INCON1
BIGOCT: INHELP <36-bit octal number>; ;ENTY FOR 36-BIT OCTAL MAGNITUDE
BIGOC1: PUSH P,F
MOVEI F,10
INCON1: PUSH P,B ;ENTRY FOR 36-BIT MAGNITUDE OF BASE IN F
PUSH P,C
PUSH P,D
PUSH P,E
MOVE D,.BFP
HRREI C,-1(CNT)
SETZ A,
JUMPLE C,OCTAL7 ;NULL INPUT
TLZ Z,F3 ;NO MINUS SIGN SEEN
ILDB E,D ;GET FIRST CHAR
CAIE E,"-"
JRST OCTAL3 ;NOT MINUS, GOBBLE NUMBER
TLO Z,F3 ;SAY NEGATION NEEDED AT END
SOJLE C,OCTAL7 ;NULL, EXCEPT FOR - SIGN
OCTAL2: ILDB E,D
OCTAL3: CAIGE E,"0"(F)
CAIGE E,"0"
JRST CERR ;NON-DIGIT, NON-BLANK
MUL A,F
LSH B,1
LSHC A,-1
ADDI B,-60(E)
JUMPN A, CERR ;OVERLFLOW
MOVE A,B
SOJG C,OCTAL2
TLNE Z,F3
MOVNS A ;RETURN NEGATIVE NUMBER IF - SEEN
ALTYPE ( )
AOS -5(P)
OCTAL7: POP P,E
POP P,D
POP P,C
POP P,B
POP P,F
RET
OCTAL: INHELP <18-bit octal number>;ENTRY FOR 18 BITS OCTAL (FOR ADDR)
CALL BIGOC1
RET
TLNE A,-1
JRST CERR
AOS (P)
RET
;OCTCOM OCCOM3 OCCOM5 OCCOM8
;"OCTCOM": 36-BIT OCTAL INPUT CONVERSION,
;ALLOWING ONE FIELD, OR TWO 18-BIT HALF-WORDS SEPARATED BY
; SPACE, ALT MODE, COMMA, OR TWO COMMAS.
;TERMINATORS ACCEPTED: ALT MODE, SPACE, EOL.
;CAN READ FIELD AFTER VALUE, HENCE GENERALLY ONLY VALID IF NUMBER
; IS LAST FIELD IN COMMAND.
OCTCOM: CALL BIGOCT ;GET WHOLE VALUE OR LH
RET ;NULL, GIVE RETURN 1
PUSH P,A ;VALUE IN PUSHDOWN
TRNE CBT,TEOL
JRST OCCOM8 ;EOL ENDS IT - ANOTHER HALF NOT ALLOWED.
TRNN CBT,TALT+TSPC
JRST OCCOM3
;AFTER SPACE OR ALT MODE PERMIT RH.
CALL OCTAL ;OPTIONAL 18-BIT VALEE FOR RH
JRST [ TLO Z,BAKFF ;NULL FIELD, BACKUP & RETURN
JRST OCCOM8]
JRST OCCOM5
OCCOM3: ALLOW TCOM
;AFTER COMMA ALLOW ANOTHER AND REQUIRE RH
CALL OCTAL
JRST [ ALLOW TCOM ;NULL, NOT OCTAL, HAS TO BE 2ND COMMA.
CALL OCTAL ;NOW RH IS MANDATORY
JRST CERR
JRST .+1]
;HAVE RH IN A. CHECK TERMINATOR, COMBINE
OCCOM5: ALLOW TEOL+TSPC+TALT
EXCH A,(P)
TLNE A,-1
JRST CERR ;MORE THAN 18 BITS IN LH
HRLM A,(P) ;COMBINE IN PUSHDOWN
OCCOM8: POP P,A ;RETURN VALUE IN A
AOS (P) ;SKIP
RET
;TOCT
;OUTPUT OCTAL NUMBER FROM B, NO LEADING ZEROES OR SPACES.
TOCT: PUSH P,A
PUSH P,C
MOVE A,COJFN ;DESTINATION
MOVE C,[1B0+10] ;"MAGINITUDE" FLAG AND RADIX
NOUT
CALL JERRC ;GENERAL JSYS ERROR, CODE IN C
POP P,C
POP P,A
RET
;BUFFS BUFFF BUFF0 BUFFF1 BUFFF2 BUFFF3
;BUFFF
;SUBROUTINE TO BUFFER LAST FIELD IN A MANNER SUITABLE FOR JSYS'S AND
; RETURN A BYTE PTR TO IT IN A.
;COPIES TO SEPARATE BUFFER SPACE, PUTS NULL BYTE AT END.
;BUFFS IS THE SAME AS BUFFF BUT THE STRING SOURCE IS SUPPLIED IN B
BUFFS: PUSH P,B
JRST BUFF0
BUFFF: PUSH P,B
MOVE B,.BFP
BUFF0: PUSH P,C
PUSH P,D
MOVE A,CSBUFP ;STRING BUFFER POINTER
MOVEI C,↑D8(A) ;POINTER + MAX STRING LENGTH
CAIL C,CSBUFE ;COMPARE TO BUFFER END
ERROR <Overflow of EXEC's string storage area>
MOVE C,CNT
CAILE C,↑D40 ;THIS HELPS PROTECT AGAINST CSBUF OVERLFOW
ERROR <Word too long>
SOJLE C,BUFFF2 ;COUNT IS 1 FOR NULL FIELD
BUFFF1: ILDB D,B
CAIL D,141 ;ASCII LOWER CASE A
CAILE D,172 ;..Z
JRST .+2
SUBI D,40 ;TRANSLATE LOWER CASE TO UPPER
CAIN D,CONTCH ;SPECIAL CHARACTER STORED WHEN "&" INPUT FOR
MOVEI D," " ;..LINE CONTINUATION. TRANSLATE IT TO SPACE.
IDPB D,A
JUMPE D,BUFFF3 ;STOP ON NULL
SOJG C,BUFFF1 ;OR IF ALL CHARACTERS MOVED
BUFFF2: SETZ D,
IDPB D,A ;TERMINATE WITH NULL
BUFFF3: EXCH A,CSBUFP
POP P,D
POP P,C
POP P,B
RET
;ALLBK NALNBK BRKST1 NOECHO DOECHO ECHOST
;SUBROUTINE TO SET BREAK SET TO "ANY CHARACTER"
ALLBK: PUSH P,C
MOVEI C,17
JRST BRKST1
;SUBROUTINE TO SET BREAK SET TO WAKE UP ON NON-ALPHANUMERICS
NALNBK: PUSH P,C
MOVEI C,16
BRKST1: PUSH P,A ;ENTRY TO SET BREAK SET BITS FROM C
PUSH P,B
MOVE A,CIJFN
RFMOD ;READ TELETYPE MODE WORD
DPB C,[POINT 6,B,23] ;NEW BREAK SET BITS
SFMOD ;SET MODE WORD
POP P,B
POP P,A
POP P,C
RET
;SUBROUTINE TO TURN OFF ECHOING BEFORE PASSWORD INPUT
NOECHO: PUSH P,C
TLO Z,NECHOF ;SAY ECHOING OFF (TESTED IN %NOI)
MOVEI C,0 ;SAY NO ECHOING NOHOW
JRST ECHOST ;JOIN "DOECHO"
;SUBROUTINE TO TURN ON ECHOING AFTER PASSWORD INPUT
DOECHO: PUSH P,C
TLZ Z,NECHOF ;SAY ECHOING NOT SUPPRESSED
MOVEI C,2 ;SAY IMMEDIATE OR DEFERRED ECHOING
ECHOST: PUSH P,A ;ENTRY TO SET ECHO BITS FROM C
PUSH P,B
MOVE A,CIJFN
RFMOD ;READ TELETYPE MODE WORD
DPB C,[POINT 2,B,25]
SFMOD ;SET TTY MODE WORD
POP P,B
POP P,A
POP P,C
RET
;NOECEO NOECE1 DOECEO
;SUPPRESS EOL ECHOING: CHANGE CONTROL CHARACTER OUTPUT CONTROL
;BITS SO EOL'S DON'T PRINT.
NOECEO: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,COJFN
RFCOC
TRZ B,3B21+3B27 ;TURN OFF LF AND CR
TRZ C,3B27 ;TURN OFF EOL
NOECE1: SFCOC ;DOECEO JOINS HERE
JRST [ POP P,C
POP P,B
POP P,A
RET]
;TURN ON EOL ECHOING/PRINTING
DOECEO: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,COJFN
RFCOC
; TLZ B,(3B15)
; TLO B,(2B15) ;TURN ON BELL
TRO B,2B21+2B27 ;TURN ON LF AND CR
TRO C,2B27 ;TURN ON EOL
JRST NOECE1
;LTTYMD LTTYM8 LTTYM9
;LTTYMD - LOAD TELETYPE MODES
;AC E POINTS TO 11-WORD BLOCK OF VALUES TO PUT INTO EFFECT:
; 0 FILE (TERMINAL) MODE WORD
; 1-3 TAB STOPS
; 4-5 CCOC WORDS
; 6 JOB TERMINAL INTERRUPT WORD
; 7 DEFERRED WORD
; 10 SUBSYSTEM NAME
LTTYMD: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
SKIPN 0(E) ;WILL BE 0 IF DETACHED (AUTOSTART)
JRST LTTYM8 ;SO JUST DO TIW AND SETNM
MOVE A,COJFN
MOVE B,(E) ;FILE MODE WORD
SFMOD
MOVE B,1(E) ;3 TAB STOPS WORDS
MOVE C,2(E)
MOVE D,3(E)
STABS
MOVE B,4(E) ;2 CCOC WORDS
MOVE C,5(E)
SFCOC
LTTYM8: MOVEI A,400000
RPCAP
JUMPGE C,LTTYM9 ;CAN'T SET TIW IF NO ↑C PRIV
; TLO A,(1B0) ;SAY SET DEFERRED INTS TOO
MOVE B,6(E) ;INTERRUPT MASK
; MOVE C,7(E) ;DEFERRED INT MASK
STIW
LTTYM9: MOVE A,10(E)
SETNM ;SUBSYSTEM NAME
JRST [ POP P,D
POP P,C
POP P,B
POP P,A
RET]
;RTTYMD RTTYM9
;RTTYMD - STORE CURRENT TTY MODE, TAB STOPS, CCOC
; INTO BLOCK THAT AC E POINTS TO.
RTTYMD: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
SKIPN ETTYMD+0 ;RETURNING FROM DETACHED STARTUP?
JRST [ GJINF ;YES
CAMN 4,[-1] ;STILL DETACHED?
JRST RTTYM9 ;YES
MOVE 2,[1B4+↑D66B10+↑D72B17+17B23+2B25+1B26+1B29+1B31]
MOVEM 2,ETTYMD+0
MOVE 1,COJFN
STPAR
JRST .+1]
MOVE A,COJFN
RFMOD
MOVEM B,(E)
GTABS
MOVEM B,1(E)
MOVEM C,2(E)
MOVEM D,3(E)
RFCOC
MOVEM B,4(E)
MOVEM C,5(E)
RTTYM9: GETNM
MOVEM A,10(E)
JRST [ POP P,D
POP P,C
POP P,B
POP P,A
RET]
;INETTY INPTTY
;NOTE: ALL MODE STUFF IN EXEC IS DONE WITH OUTPUT FILE, WHICH IS
;LESS LIKELY TO BE REDIRECTED TO NON-TTY THAN INPUT.
;MODE IS UNLIKELY TO NEED CHANGING FOR NON-TTY INPUT FILE;
;TO CHANGE IT USER MUST: A) USE A PROGRAM, SUCH AS DDT, OR B) TEMP SET
; OUTFILE=INFILE (IF PSEUDO-ECHOING DOESN'T INTERFERE). 4/22/70.
;INITIAL EXEC TTY STATE
INETTY: 0 ;MODE WORD SAYS "DET" UNTIL WE GET A TTY
1B0+1B8+1B16+1B24+1B32 ;TABS
1B4+1B12+1B20+1B28
1B0+1B8+1B16+1B24+1B32
BYTE (2) 0,0,1,1,1,0,0,2,2,2,2,1,2,2,1,1,1,1 ;CCOC WORDS
BYTE (2) 0,1,1,1,0,0,0,1,1,0,1,1,1,2,0,0,0,0
1B<CTRLC>!1B<CTCODE>!1B<HUCODE>;!1B16 ;EXEC TERM. INT. WORD
0; 1B<CTRLC> ;DEFERRED INT'S. WHILE IN EXEC
'EXEC ' ;SUBSYSTEM NAME
;INITIAL PROGRAM TTY MODES
INPTTY: 0
1B0+1B8+1B16+1B24+1B32
1B4+1B12+1B20+1B28
1B0+1B8+1B16+1B24+1B32
BYTE (2) 0,0,1,1,1,0,0,2,2,2,2,1,2,2,1,1,1,1
BYTE (2) 0,1,1,1,0,0,0,1,1,0,1,1,1,2,0,0,0,0
1B<CTRLC>!1B<CTCODE>!1B<HUCODE> ;PROGRAM TERM INT WRD
0; 1B<CTRLC> ;DEFERRED WHILE PROGRAM RUNNING
'(PRIV)'
;%PRINT PRIN1 CCHRO COUTC
;UUO TO OUTPUT SINGLE ASCII CHARACTER FROM EFFECTIVE ADDRESS
%PRINT: PUSH P,A
PUSH P,B
AOS TTYACF ;TELL AUTOLOGOUT CODE THAT TTY IS ACTIVE
MOVE A,COJFN
HRRZ B,40
CAIN B,37 ;TENEX EOL?
JRST [ MOVEI 2,CR
BOUT
AOS TTYACF
MOVEI 2,12
JRST PRIN1] ;THAT OUGHT TO KEEP THE FTP GUYS HAPPY
PRIN1: BOUT
AOS TTYACF ;AGAIN, MAYBE BLOCKED DUE TO FULL BUFFER
POP P,B
POP P,A
RET
;SUBR TO OUTPUT CHARACTER FROM B.
;ALSO STORE IT IN CBUF (POINTER "CBP") IF FLAG "STCF" ON
; (AS DURING PRINTING AFTER ALT MODE).
;TRANSLATES SPECIAL INTERNAL CHARACTER FOR LINE CONTINUATION BACK
; TO &-EOL-SPACE, AS REQUIRED FOR ↑R AND ↑A EDITING CHARACTERS.
CCHRO: CAIN B,CONTCH ;CONTINUATION CHARACTER
JRST [ UTYPE [ASCIZ /&
/]
RET]
TLNN Z,STCF
JRST COUTC
PUSH P,B
MOVEI B,(BFP)
CAIL B,CBUFE
ERROR <Command too long>
POP P,B
IDPB B,BFP
AOJ CNT,
;FOLLOWS CCHRO...
;OUTPUT CHARACTER FROM B WITHOUT STORAGE FLAG TEST (USED?)
COUTC: PUSH P,A
AOS TTYACF ;TELL AUTOLOGOUTTTY IS ACTIVE
MOVE A,COJFN ;FILE NUMBER OF PRIMARY OUTPUT FILE
BOUT
AOS TTYACF
POP P,A
RET
;MAPPF MPPF1 MPPF8 MAPACS LOADF STOREF
;MAP A PAGE OF A FORK
;TAKES: AC A: AN ADDRESS IN THE PAGE, OR -1 TO CLEAR BUFFER
; CELL "FORK": FORK HANDLE
;RETS: AC A: ACCESS AND EXISTENCE BITS IN B2-5, RH PRESERVED
; BUFFER PAGEN: THE PAGE MAPPED
MAPPF: PUSH P,C
PUSH P,B
PUSH P,A
JUMPL A,MPPF1
MOVEI A,0(A)
CAIG A,17
JRST MAPACS
LSH A,-↑D9 ;SEPARATE PAGE #
HRL A,FORK ;FORK HANDLE OF PAGE WE WANT
SKIPGE FORK ;IS THERE A CURRENT FORK?
ERROR <No program>; ;NO.
TLO A,B0 ;SAY FORK HANDLE NOT JFN
MPPF1: MOVEI B,PAGEN ;GENERATE DESTINATION PAGE IDENTIFIER
LSH B,-↑D9 ;...MUST SHIFT AT RUN TIME CAUSE EXTERNAL
TLO B,B0 ;...SAY THIS FORK
HRLZI C,B2+B3+B4 ;REQUEST ALL ACCESS, NORMAL DISPOSAL
CAME A,NPAGE ;SAVE TIME IF ALREADY MAPPED
PMAP ;MAP IT
MOVEM A,NPAGE ;SAY ITS MAPPED
CAME A,[-1]
RPACS ;GET ACCESS/EXISTENCE OF MAPPED PAGE
MPPF8: POP P,A ;RH A TRANSPARENT
HLL A,B ;ACCESS IN LH A
POP P,B
POP P,C
RET
;REFERENCE IS TO AN AC. READ ACS INTO PAGEN WITH "RFACS".
;IN THIS CASE CALLER MUST USE SFACS IF HE WISHES TO CHANGE A LOCATION.
MAPACS: SETO A,
CALL MAPPF ;UNMAP PAGE IN BUFFER, IF ANY.
SKIPGE A,FORK
ERROR <No program>
MOVEI B,PAGEN
RFACS ;READ FORK ACS INTO "PAGEN"
HRLZI B,B2+B3+B4+B5 ;SIMULATE ALL ACCESS BITS
JRST MPPF8
;LOAD SINGLE WORD FROM FORK, GIVEN ADDRESS IN A
LOADF: CALL MAPPF
TLNN A,B5
ERROR <No such page>
TLNN A,B2
ERROR <Can't read that page>
ANDI A,777
MOVE A,PAGEN(A)
RET
;STORE SINGLE WORD FROM B INTO FORK, ADDRESS IN A
STOREF: CALL MAPPF
TLNE A,B5 ;OK TO STORE IF PAGE NON-EXISTENT
TLNE A,B3!B9 ;OR IF WRITE ACCESS PERMITTED
CAIA
ERROR <Can't write into page>
ANDI A,777
MOVEM B,PAGEN(A)
RET
;%GTB
;%GTB
;UUO TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE.
;TABLE # IN EFF ADDR, INDEX IN RH OF D, ONE RETURN WITH WORD IN A.
;TYPICAL USAGE: LH D CONTAINS AOBJN COUNTER, B AND C ARE FREE
; FOR USE IN OTHER JSYS CALLS INSIDE LOOP.
%GTB: HRL A,D
HRR A,40
GETAB
CALL JERR
RET
;HUPSI HUPSI9 HUPSI8 HUPSI7
;ERROR, PSEUDO-INTERRUPT, %-MESSAGE-TYPING STUFF
;PSI ROUTINE FOR DATAPHONE CARRIER OFF (HANGUP).
;TERMINAL CODE ↑D30, ASSIGNED TO CHANNEL 4, LEVEL 2.
;DETACHES JOB TO FREE UP DATAPHONE, KILLS JOB IF NOT LOGGED IN.
HUPSI: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
GJINF
JUMPL D,HUPSI9 ;DETACHED ALREADY, IGNORE IT.
MOVEI A,-1 ;REFERENCE CONTROLLING TTY EVEN IF ITS NOT
;PRI I/O FILE
RFMOD
TRNE B,1B25
JUMPL D,HUPSI9 ;CARRIER NOT NOW OFF, IGNORE.
DTACH ;DETACH CONTROLLING TERMINAL
GJINF ;GETS TSS JOB # IN A
JUMPG A,HUPSI8 ;JUMP IF LOGGED IN
SETO A, ;NOT LOGGED IN, SAY SELF,
LGOUT ;KILL JOB.
CALL JERR
HUPSI9: POP P,D
POP P,C
POP P,B
POP P,A
DEBRK
;HANGING UP ON LOGGED IN JOB RESULTS IN DETACH AND FREEZE.
;IF JOB IS NOT REATTACHED WITHIN 20 MINUTES, IT IS LOGGED OUT
HUPSI8: MOVEI A,-4
TLNE Z,RUNF
FFORK ;FREEZE ALL INFERIORS
TIME
MOVE 2,1
ADD 2,[↑D1200000] ;20 MINUTES
HUPSI7: PUSH P,2
MOVEI 1,↑D3000
DISMS ;WAIT 3 SECONDS
GJINF ;GET CONTROL TTY NOW
TIME
POP P,2
JUMPGE 4,[MOVEI A,-4 ;IF JOB NOW RE-ATTACHED,
TLNE Z,RUNF
RFORK ;RESUME RUNNING
JRST HUPSI9]
CAMGE 1,2 ;WAITED 20 MINUTES?
JRST HUPSI7 ;NO, WAIT SOME MORE
SETO A, ;YES, JOB IS DEFINED AS ABANDONED
LGOUT ;SO LOG IT OUT
CALL JERR
;USEPSI USEPS4 USEPS5 USEPS6 DING
;PSI ROUTINE FOR TERMINAL CHARACTER THAT PRINTS RUNTIME (↑T)
USEPSI: PUSH P,40
PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,COJFN
RFCOC
PUSH P,B ;SAVE CCOC WORDS
PUSH P,C
CALL DOECEO ;MAKE SURE CCOC IS SUCH THAT EOLS PRINT
;AND THAT BELLS DING
; MOVEI 2,BELL
; BOUT
;USEPS1: GTAD ;"NOW"
; CAMG 1,CTLIM0 ;2ND ↑T WITHIN 15 SEC?
; CAMG 1,CTLIM1 ;AND AT LEAST A MIN SINCE LAST TYPEOUT?
; JRST USEPS3 ;NO
;
;USEPS2: MOVEI 2,CTTIM1 ;ONE MINUTE
; CALL TIMPSC ;TAD IN 1 PLUS SECONDS IN 2
; MOVEM 1,CTLIM1 ;CLOSEST TIME OF NEXT FULL TYPEOUT
; JRST USEPS4 ;GO DO FULL TYPEOUT
;
;USEPS3: MOVEI 2,CTTIM0 ;SECONDS
; CALL TIMPSC
; MOVEM 1,CTLIM0 ;UPDATE 15 SECONDS BETWEEN ↑T TIMER
; JRST USEPS6 ;AND SKIP FULL TYPEOUT
USEPS4: SKIPGE A,FORK
JRST USEPS5 ;NO INFERIOR
PRINT " "
CALL FSTAT ;PRINT STATUS & PC OF INF (HANDLE IN A)
PRINT " " ;FSTAT IS IN XMAIN.MAC
USEPS5: CALL LAPRNT ;PRINT LOAD AV. NEAR "RUNSTAT"
ETYPE <, used %V in %C
>
USEPS6: MOVE A,COJFN
POP P,C
POP P,B
SFCOC ;RESTORE CCOC
POP P,C
POP P,B
POP P,A
POP P,40
DEBRK
;DING
;SUBROUTINE TO RING BELL, CLEAR INPUT BUFFER, STOP NON-INTERACTIVE JOB.
;USED AFTER RECOGNITION AMBIGUITIES AND SUCH ERRORS.
DING: PUSH P,A
MOVE A,CIJFN ;COMMAND INPUT FILE JFN
CFIBF ;CLEAR INPUT BUFFER
BTCHERR ;THIS SHOULD STOP NON-CONVERSATIONAL JOB
PRINT BELL ;OUTPUT BELL
POP P,A
RET
;CERR NIM NIYE SCREWUP JERR JERR1 JERRC
;REGULAR ERROR - SYNTAX OR OBVIOUS SEMANTIC ERROR
CERR: $ERROR < ?>
;NOT IMPLEMENTED YET ERROR
;DISPATCH TO HERE AUTOMATICALLY SUPPLIED BY COMMAND TABLE ENTRY MACRO
; IF NO ROUTINE IS DEFINED FOR THE COMMAND.
NIM:
NIYE: ERROR <Not implemented yet>
;INTERNAL ERROR
SCREWUP:HRRZ E,(P) ;PC (GET HERE WITH PUSHJ)
SUBI E,1
ERROR <EXEC screwed up at %5P ACs %1O %2O %3O>
;ERROR RETURN FROM A JSYS, SYSTEM ERROR # IN 1.
;PRINTS SYSTEM MESSAGE AND GOES BACK TO COMMAND INPUT.
;MOST ERROR RETURNS WILL REQUIRE SOME SPECIAL CASE CHECKS
; BEFORE COMING TO THIS GENERAL ROUTINE.
;NOTE: ERROR NUMBER IN A IS USED INSTEAD OF -1 ARG TO "ERSTR"
; BECAUSE THIS ROUTINE IS ALSO USED WITH SUBROUTINES THAT SIMULATE
; JSYS'S. 6/26/70.
JERR: MOVEM A,ERCOD ;SAVE ERROR NUMBER
JERR1: PUSH P,A
INTON ;BE SURE INTERRUPTS ARE ON
POP P,A
CALL ERFRST ;GET SET TO TYPE MSG
CALL CRIF ;EOL UNLESS AT LEFT
TYPE <JSYS error return in EXEC>
HRRZ F,(P) ;PC (GOT TO JERR WITH PUSHJ)
SUBI F,2 ;PROBABLE LOC OF JSYS
PRINT EOL
ETYPE < PC %6P ACs %1O %2O %3O>
JRST SYSERA ;GO TYPE SYSTEM ERROR MESSAGE
JERRC: MOVEM C,ERCOD ;"JERR" FOR ERROR CODE IN C
JRST JERR1 ; (AS AFTER "NOUT")
;%TRAP
;ERROR PSEUDO-INTERRUPT ON LEVEL 1 UUO SERVICE ROUTINE
;DEBREAK IMMEDIATELY BECAUSE IF ANOTHER TRAP WERE TO OCCUR DURING
;THIS ONE, MONITOR MIGHT HAVE TROUBLE HANDLING IT.
;THEN TYPE TEXT EFF ADDR POINTS TO, "TRAP IN EXEC",
; TYPE SYSTEM ERROR MESSAGE WITH
; REGULAR ROUTINE, AND RETURN TO COMMAND INPUT.
%TRAP: PUSH P,D
PUSH P,E
HRRZ E,LEV1PC ;GET PC OF ERROR
CIS ;CLEAR THIS INTERRUPT,
;ALSO CLEAR LOWER-LEVEL INTRPTS
;SUCH AS ↑T AND CARRIER-OFF.
;NOPS IF NOT ON A PSI,
;WHICH CAN HAPPEN VIA SPECIAL CASE IL INST STUFF.
MOVEI D,RERET ;CHANGE ERROR ROUTINE RETURN
MOVEM D,CERET ;...TO "REGULAR"
SETZM .JBUFP ;SAY FLUSH ALL JFNS
;HERE WE MUST CHECK FOR EOF IN COMMAND FILE AND HANDLE SPECIALLY.
;ALSO I'M SURE MANY OTHER EXECEPTIONAL CASES WILL TURN UP.
MOVE D,40 ;SAVE TEXT ADDRESS
CALL ERFRST ;DO THINGS NEEDED BEFORE TYPING MESSAGE
CALL CRIF ;EOL IF CARRIAGE NOT AT LEFT MARGIN
UTYPE (D) ;TYPE CHANNEL-SPECIFIC MESSAGE
TYPE < trap in EXEC>
PRINT EOL
ETYPE < PC %5P% ACs %1O %2O %3O>;
POP P,E
POP P,D
JRST SYSERM ;GO TYPE SYSTEM ERROR MESSAGE.
;NOTE: IN THE EXEC THERE ARE NO INTERRUPTS WHICH DEBREAK TO THE POINT
;OF INTERRUPTION. HENCE WE NEEDN'T WORRY ABOUT CELLS SUCH AS "RERET"
;BEING CHANGED. BUT WE DO HAVE TO CODE ROUTINES SUCH AS "RLJFNS" TO
;WORK OK IF INTERRUPTED IN THE MIDDLE AND RESTARTED.
;ILIPSI EOFPSI
;ILLEGAL INSTRUCTION PSI
;GO TO SPECIAL CASE ROUTINE ILIDSP POINTS TO, IF NON-0,ELSE
;TREAT LIKE OTHER ERROR PSI'S.
;ILIDSP USED, FOR INSTANCE, TO DETECT "LIST ACCESS NOT ALLOWED" FROM
; GTFDB JSYS.
;SPECIAL ROUTINE GETS PC IN ERPC, ERROR CODE IN ERCOD.
;IF SPECIAL ROUTINE ISN'T INTERESETED IN THIS PARTICULAR ERROR,
; IT CAN JRST TO ILIPSI AGAIN.
ILIPSI: SKIPN ILIDSP ;IS THERE A SPECIAL DISPATCH?
TRAP <Illegal instruction>; NO. NORMAL CASE.
CIS ;CLEAR THE INTERRUPT (NOPS IF NONE), CLEAR LOWER
;LEVEL INTERRUPTS SUCH AS ↑T AND CARRIER OFF.
PUSH P,ILIDSP ;SAVE SPECIAL DISPATCH ADDR FOR "RET" BELWOW
PUSH P,A
PUSH P,B
HRRZ A,LEV1PC
MOVEM A,ERPC ;LOCATION OF ERROR, FOR SPECIAL ROUTINE.
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH TO PROTECT
MOVEM A,41 ;IT FROM MALICIOUS USERS
SETZM ILIDSP ;CLEAR SPECIAL DISPATCH
MOVEI A,B0
CALL $GETER ;DO GETER JSYS AND RESTORE 4-10
HRRZM B,ERCOD ;ERROR CODE, FOR SPECIAL ROUTINE
POP P,B
POP P,A
RET ;DISPATCH TO SPECIAL ROUTINE
;END-OF-FILE INTERRUPT
;DEBREAK TO SPECIAL ROUTINE "EOFDSP" POINTS AT, OR,
; IF EOFDSP ZERO, TREAT LIKE OTHER ERROR PSEUDO-INTERRUPTS.
;"EOFDSP" IS NORMALLY ZERO BUT IS SET NON-0 FOR FILE-COPYING COMMANDS.
EOFPSI: SKIPN EOFDSP
TRAP <Unexpected end-of-file>; NO SPEC DISPATCH, TREAT AS ERROR
PUSH P,A
MOVE A,EOFDSP ;CHANGE INTERRUPT RETURN
HRRM A,LEV1PC ;OLD PC IS LOST
SETZM EOFDSP ;FUTHER INTERRUPTS ARE ERRORS
POP P,A
DEBRK
;DATPSI
;FILE DATA ERROR INTERRUPT
;TYPES A MORE USER-ORIENTED MESSAGE THAN "TRAP" UUO.
;IF A COPY OPERATION, ETC, IS IN PROGRESS, IT GETS ABORTED AND
; FILES ARE CLOSED, SO OUTPUT FILE IS TRUNCATED.
DATPSI: CIS ;CLEAR INTERRUPT (AND LOWER ONES!)
MOVEI E,RERET
MOVEM E,CERET ;REST ERROR RETURN TO "NORMAL"
SETZM .JBUFP
HRRZ E,LEV1PC
ERROR <File data error at EXEC PC %5P>;
;SHOULD GET JFN (GETER?) AND PUT NAME IN ABOVE MESSAGE
;AND PROBOBLY ELIMINATE PC. ←←←←←←←←←←←
;CCPSI
;SUPER-PANIC CHARACTER (CURRENTLY ↑C) PSEUDO-INTERRUPT ROUTINE.
;CHANNEL 1, LEVEL 1
CCPSI: TLOE Z,CTLCF1 ;SAY WE'VE SEEN AN ↑C
TLO Z,CTLCF2 ;IF ITS THE SECOND ONE, SAY SO
;(CTLCF2 CAUSES OUTBUF TO BE CLEARED).
SETZM ILIDSP ;CLEAR SPECIAL IL INST DISPATCH ADDRESS
CIS ;CLEAR THIS INTERRUPT
;AND ANY LOWER LEVEL ONES SUCH AS
;↑T OR CARRIER OFF.
;DOING THIS RIGHT OFF CAUSES
;MULTIPLE ↑C'S TO BE DETECTED
;PROPERLY AND MAKES IL
;INST TRAP WORK DURING ↑C ROUTINE.
MOVE A,CIJFN
CFIBF ;ALWAYS RESET INPUT BUFFER ON ↑C
MOVEI A,CCERET ;SET ERROR ROUTINE TO SPECIAL ↑C VALUE
MOVEM A,CERET ;..
SETZM .JBUFP ;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF
MOVEM A,41 ;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41
;TO MAKE EXEC TRANSFER TO ANY CODE THEY WISH).
SKIPL A,EFORK ;IF EPHEMERON RUNNING,
FFORK ;FREEZE IT
JUMPGE A,CCDB4 ;AND SKIRT AROUND TTY STUFF
TLNN Z,RUNF ;PROGRAM RUNNING?
JRST CCDB3 ;NO.
MOVE A,LRFORK ;LAST PROGRAM RUN IS WHERE ↑C CAME FROM
FFORK ;FREEZE THE WORLD
MOVEI E,PTTYMD
CALL RTTYMD ;STORE TTY MODES FOR "CONTINUE".
;CCDB2 CCDB3 CCDB4 CCERET
;↑C...
CCDB2: TLZ Z,RUNF ;DON'T DO TTY MODES ON 2ND ↑C!
CCDB3: MOVEI E,ETTYMD ;PUT EXEC'S TTY MODES INTO EFFECT.
CALL LTTYMD ;MUST ALWAYS BE DONE
;EG GTJFN LEAVES THEM BAD.
CCDB4: MOVE A,COJFN
TLNN Z,CTLCF2 ;2ND ↑C?
JRST [ SETZM ERRMF
U.$ERR [ASCIZ /↑C/] ;DON'T CLEAR INPUT BUFFER
JRST CCERET] ;SO NO ERR IN ERR
CFOBF ;YES, CLEAR OUTPUT BUFFER.
;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "↑C", RELEASE JFNS,
;AND GENERALLY CLEAN UP.
;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE.
SETZM ERRMF ;CLEAR "PROCESSING AN ERROR" FLAG
;ANOTHER ↑C WHILE PROCESSING 1ST IS OK
$ERROR <↑C>; ;NO CR FIRST!
CCERET: MOVE A,COJFN
TLNN Z,CTLCF2 ;BUT DON'T WAIT IF 2ND ↑C
DOBE ;2ND ↑C MAY HAPPEN HERE
TLZ Z,CTLCF1+CTLCF2
JRST ERRET ;RETURN TO COMMAND INPUT
;ALOPSI ALOPS1 AUTOLO AUTOL6
;AUTOLOGOUT PSI AND ROUTINE
;PROGRAM-GENERATED PSI ON CHANNEL 2, LEVEL 1 DISPATCHES HERE
ALOPSI: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
GJINF ;GETS LOGIN USER # IN A
JUMPLE A,ALOPS1 ;NOT LOGGED IN - EXPECTED CASE.
POP P,D ;USER GOT LOGGED IN DURING SCHEDUALING OF PSI
POP P,C ;OR SOME SUCH STRANGE CASE, JUST IGNORE PSI.
POP P,B
POP P,A
DEBRK ;DEBREAK TO INTERRUPTED LOCATION
ALOPS1: CIS ;ITS REAL. CLEAR PSI SYSTEM SO AUTOLOGOUT
;IS DONE NOT ON AN INTERRUPT LEVEL.
;EXEC'S MAIN FORK JRST'S HERE,
;ALSO PSI FALLS INTO HERE, TO DO AUTOLOGOUT.
;MAKE CHECKS, TYPE MESSAGE, LOG JOB OUT.
AUTOLO: SKIPLE CUSRNO ;SKIP IF NOT LOGGED IN
ERROR <Autologout screwup in EXEC>
GJINF ;GETS CONTROLLING TTY # IN 4
CAMN D,[-1] ;-1 IF NONE (DETACHED)
JRST AUTOL6 ;DETACHED, TYPING MESSAGE WOULD HANG JOB.
;CAN BE DETACHED IF DATAPHONE
;HUNG UP AND CARRIER-OFF PSI
;ISN'T FULLY PROCESSED,
;OR IF ATACH HAS SOMEHOW FAILED TO
;COMPLETE.
CALL DOECEO ;MAKE EOL'S PRINT!
TYPE <
Autologout - bye bye!
>
MOVE A,COJFN
DOBE ;MAKE SURE IT ALL TYPES (NEEDED?)
AUTOL6: SETO A, ;SAY SELF
LGOUT ;LOG JOB OUT
CALL JERR ;SHOULDN'T BE ABLE TO HAPPEN.
;%ERR %.$ERR SYSERA SYSERM ERR1 ERR5 ERR04 ERR5A ERR6
;ERROR UUO HANDLER. MESSAGE TEXT AT EFFECTIVE ADDRESS.
;SERVICES UUO'S UERR, U$ERR, U.$ERR (MACROS ERROR, $ERROR AND .$ERROR)
%ERR: %$ERR: TLZA Z,F1
%.$ERR: TLO Z,F1 ;SAY DON'T CLEAR INBUF (ERFRS1)
PUSH P,40 ;TEXT ADDRESS AND UUO VALUE
CALL ERFRS1 ;SETUP BEFORE TYPING ERROR MSG
JRST ERR1
;ENTER HERE TO TYPE SYSTEM ERROR MESSAGE FOR ERROR # IN "ERCOD"
;MUST HAVE ALREADY CALLED "ERFRST"
SYSERA: PUSH P,[-2]
JRST ERR1
;ENTER HERE TO TYPE MOST RECENT SYSTEM ERR MESSAGE
SYSERM: PUSH P,[-1] ;INDICATE USE OF SYSTEM ERROR MESSAGE
AOS .JBERR
;TYPE MESSAGE: CR FIRST UNLESS ALREADY AT LEFT, THEN SPACE (ALWAYS),
;THEN TEXT, THEN CR, BUT NO INITIAL CR-SPACE IF "U$ERR" UUO.
ERR1: PUSH P,A ;AC'S MUST BE SAVED FOR ETYPE OR ERSTR
PUSH P,B
HLRZ B,-2(P) ;-2 FOR SYSTEM MSG, OR UUO FOR EXEC MSG
CAIE B,<U.$ERR>B53
CAIN B,<U$ERR>B53
CAIA ;NO CR-SPC FOR U$ERR UUO ($ERROR MACRO)
CALL CRIF ;TYPE EOL IF NOT ALREADY AT LEFT
ERR5: INTOFF
SKIPGE A,EFORK ;USE EPHEMERAL FORK IF IT EXISTS
MOVEI A,400000 ;OR EXEC IF NOT
MOVE B,-2(P) ;0, -1, -2, OR UUO-TEXT ADDRESS
JUMPG B,ERR5A ;PRINT ASCIZ TEXT SUPPLIED WITH UUO
JUMPE B,ERR6 ;PRINT NOTHING
AOJE B,[CALL $GETER ;ERROR NUMBER TO B
JRST ERR04]
HRR B,ERCOD ;-2 SAYS USE SYSTEM ERR # FROM "ERCOD"
ERR04: HRL B,A ;FORK HANDLE
MOVE A,COJFN ;DESTINATION
SETZ C, ;SAY PARAMETERS FROM PSB, NO LGTH LIMIT.
ERSTR ;SYSTEM ERROR MESSAAGE TO STRING
JRST [ UETYPE [ASCIZ /Message not found for error %2P/]
JRST ERR6] ;R +1: BAD ERROR #
JRST [ SETZ A, ;R +2: DESTINATION PROBLEM,
HFORK] ;HALT.
JRST ERR6 ;R +3: DONE.
ERR5A: MOVE B,0(P)
MOVE A,-1(P) ;ETYPE USES VALUES THAT CAME IN AC'S
UETYPE @-2(P) ;TYPE MESSAGE FROM CORE
ERR6: INTON
PRINT EOL
TLNE Z,LOGOFF
TYPE < Not logged off
>; ;ERROR DURING LOGOUT, LIKELY AFTER "LOGGED OFF" MESSAGE
;ERR7 ERR7F ERR8 RERET
;ERROR UUOS AND SYSERM...
;MESSAGE ALL TYPED.
ERR7: CALL DOECHO ;MAKE SURE ECHOING IS ON
CALL RLJFNS ;CLOSE AND RELEASE ALL JFNS USED IN CMD
PUSH P,C
PUSH P,D
HLRZ A,-4(P) ;-1 OR UUO
TLNN Z,CTLCF1 ;CHECK ↑C COUNT (KLUDGE←←←←)
CAIE A,<U.$ERR>B53 ;DON'T CLEAR BUFFERS FOR .$ERROR
CAIA
JRST ERR7F ;(USED FOR RUBOUT, ↑X (CCHRI)).
;CLEAR ALL PAGE WINDOWS, IE UNMAP PAGES OF OTHER FORKS OR FILES.
SETO A, ;PAGE OF INFERIOR FORK
CALL MAPPF
CALL UNMAP ;FLUSH BUFFER PAGES TOO
ERR7F: INTOFF ;AVOID RACE AGAINST WFORK AT CIN45
SKIPL 1,EFORK ;IS THERE AN EPHEMERAL FORK?
KFORK ;YES. FLUSH IT
SETOM EFORK ;AND SAY SO
INTON
POP P,D
POP P,C
BTCHER ;SHOULD STOP NON-CONVERSATIONAL JOB
ERR8: POP P,B
POP P,A
SUB P,[1,,1] ;FORGET UUO
;RESTORE EARLIER (LESS FULL) PLUSHDOWN
;LEVEL IF LEVEL WAS SAVED IN ".P" .
;THIS IS GENERALLY USED DURING
;INPUT.
SKIPE .P
MOVE P,.P
SETZM ERRMF ;NO LONGER PROCESSING AN ERROR
JRST @CERET ;VARIABLE ERROR RETURN. MAY GO SPECIAL
;PLACES. SUCH AS SUB-COMMAND INPUT FOR
;"DIRECTORY" COMMAND.
;REGULAR ERROR RETURN - CERET USUALLY POINTS HERE
RERET: ;DO ANY OTHER CLEANING UP
JRST ERRET ;GO BACK TO COMMAND INPUT
;ERFRST ERFRS1 ERFRS2 ERFRS3
;SUBROUTINE TO CALL BEFORE TYPING ANY ERROR MESSAGE TEXT
; OR EXECUTING ANY JSYS'S. MUST BE CALLED ONLY ONCE PER ERROR.
ERFRST: TLZ Z,F1 ;NORMAL ENTRY
ERFRS1: ;ENTER HERE TO NOT CLEAR INBUF IF F1 ON
SKIPN CINITF ;IS EXEX INITIALIZED?
HALTF ;NO, TYPING MESSAGE MIGHT FAIL & PRODUCE
;INFINITE LOOP, SO JUST HALT.
TLZ Z,BAKFF+STCF ;CLEAR FLAGS FOR:
; REUSE SAME INPUT FIELD
; STORE PRINTED CHARACTERS IN CMD BUFFER
PUSH P,A
PUSH P,B
ERFRS2: INTOFF ;BE SURE ALL UPDATED SIMULTANEOUSLY
GPJFN
SKIPGE CREDIF ;IF INPUT WAS REDIRECTED,
HLRZM 2,CRJFNI
MOVMS CREDIF ;UPDATE FLAG
SKIPGE CREDOF
HRRZM 2,CRJFNO ;SAVE FOR * OPTION OF "RED" AND "DET"
MOVMS CREDOF
MOVE 2,PRIMRY ;RESTORE JFNS WE HAD AT ENTRY
SPJFN
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH, BECAUSE OTHERWISE
MOVEM A,41 ;MALICIOUS USERS CAN MAKE EXEC TRANSFER
;TO ANY CODE THEY WISH BY PATCHING
;PAGE 0 OF PMF
INTON
ERFRS3: CALL DOECEO ;MAKE SURE CCOC IS SUCH THAT EOLS PRINT
SKIPE ERRMF ;ALREADY PROCESSING AN ERROR?
JRST [ UTYPE [ASCIZ /
Error within an error
/] ;YES, GIVE UP
JRST ERRET]
SETOM ERRMF ;SAY PROCESSING AN ERROR
MOVE A,CIJFN
DOBE
TLNN Z,F1 ;DONT CLR INBUF FOR RUBOUT, ↑X (.$ERROR)
CFIBF ;CLEAR FILE INPUT BUFFER
POP P,B
POP P,A
RET
;CRIF $GETER
;TYPE EOL UNLESS CARRIAGE IS ALREADY AT LEFT.
CRIF: PUSH P,A
PUSH P,B
MOVE A,COJFN
RFPOS ;READ FILE POSITION
MOVEI B,(B)
CAILE B,2
PRINT EOL
PRINT " " ;DON'T PRINT MSG IN COLUMN 0
JRST [ POP P,B
POP P,A
RET]
;SUBROUTINE TO DO "GETER" JSYS AND PRESERVE AC'S 4-10.
;A MUST BE SET BY CALLER, RETURNS RESULT IN B.
$GETER: PUSH P,D
PUSH P,E
PUSH P,F
PUSH P,G
PUSH P,G+1
GETER
POP P,G+1
POP P,G
POP P,F
POP P,E
POP P,D
RET
;RLJFNS RJFNS1 RJFNS8
;RELEASE JFNS USED BY COMMAND BEING DECODED OR EXECUTED --
; USED AFTER ERRORS (%ERR) AND BY COMMAND EXECUTION ROUTINES.
;CLOSES AND RELEASES JFNS STACKED IN JBUF.
;EXCEPT DOESN'T GO BELOW CONTENTS OF ".JBUFP", WHICH IS NORMALLY 0
; BUT IS SET TO PRESERVE ASSIGNED JFN'S THRU ERRORS THAT RETURN
; TO A SUBCOMMAND INPUT LOOP.
RLJFNS: PUSH P,A
PUSH P,B
PUSH P,C
MOVE C,JBUFP
RJFNS1: CAMLE C,[IOWD JBUFL,JBUF] ;STOP AT BOTTOM OF STACK,
CAMN C,.JBUFP ;OR AT SAVED POINTER LEVEL
JRST [ POP P,C
POP P,B
POP P,A
RET]
;PROCESS ONE WORD OF JBUF
HRRZ A,(C) ;GET A JFN TO CONSIDER
CAIE A,100 ;DON'T RELEASE PRIMARY
CAIN A,101
JRST RJFNS8
CAIL A,0 ;DON'T RELEASE NEGATIVE,
CAIL A,MAXJFN ;OR BIGGER IS GARBAGE
JRST RJFNS8
CAME A,CRJFNI ;DON'T CLOSE SAVED INFILE,
CAMN A,CRJFNO ;OR SAVED OUTFILE JFNS.
JRST RJFNS8
GTSTS
TLNN B,200
JRST RJFNS8 ;INVALID, FORGET IT
TLNN B,B0 ;IS IT OPEN?
JRST [ RLJFN ;NO, RELEASE IT
CALL JERR
JRST RJFNS8]
CLOSF ;YES, CLOSE AND RELEASE
CALL JERR
;DONE WITH THIS WORD
RJFNS8: SETZM (C) ;ZERO JBUF WORD
SUB C,[XWD 1,1] ;DECREMENT POINTER
MOVEM C,JBUFP
JRST RJFNS1
;%ETYPE ETYP2 ETYP2A
;%ETYPE (ETYPE MACRO, UETYPE UUO)
;HANDLER FOR UUO THAT TYPES MESSAGE, INTERPRETING % CODES.
;SPECIAL CODES ARE OF FORM %NL%
; WHERE N IS AN OPTIONAL OCTAL NUMBER SPECIFYING AN AC
; L IS A LETTER:
; D: TYPE CURRENT DATE
; J: TYPE TSS JOB #
; O: TYPE CONTENTS OF INDICATED AC IN OCTAL
; SEE DISPATCH TABLE %LETS ON NEXT PAGE FOR FULL LIST.
%ETYPE: PUSH P,Z
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
HRR A,40
HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE PTR FROM EFF ADDR
ETYP2: ILDB B,A ;NEXT CHARACTER
ETYP2A: JUMPE B,[POP P,D ;NULL TERMINATES TEXT
POP P,C
POP P,B
POP P,A
SUB P,[XWD 1,1] ;FORGET SAVED Z VALUE
RET]
CAIE B,"%"
JRST [ CALL CCHRO ;NOT A %, OUTPUT IT
JRST ETYP2]
;ETYP4 ETYP5 END%
;%ETYPE...
;"%" SEEN
SETZB C,D ;C: IF NO NUMBER, USE 0
;D: INIT NUMBER TO 0.
ETYP4: ILDB B,A ;CHARACTER AFTER %
CAIG B,"9"
CAIGE B,"0"
JRST ETYP5
IMULI D,10
ADDI D,-"0"(B) ;ADD NEW DIGIT TO NUMBER
MOVE C,D ;COMPUTE LOCATION TO GET AC FROM...
CAIG C,D ;...AC'S 5-9 ARE PRESERVED,
ADDI C,-4(P) ;...CONTENTS OF 0-4 ARE IN PUSHDOWN.
MOVE C,(C) ;FETCH CONTENTS OF AC INDICATED BY NUMBER SO FAR
JRST ETYP4 ;GO CHECK FOR ADDITIONAL DIGIT(S)
ETYP5: PUSH P,A ;SAVE BYTE PTR DURING PROCESSING
CAIL B,"A"
CAILE B,"Z" ;HIGHEST LETTER IN TABLE
CALL UN% ;NOT LETTER, UNRECOGNIZED % CODE
CALL @%LETS-"A"(B) ;DISPATCH WITH A PUSHJ THROUGH LETTER
;TABLE. AT THIS TIME C CONTAINS 0 OR
;C(INDICATED AC).
;DONE INTERPRETING A % CODE. MUST FOLLOW DISPATCH PUSHJ!
END%: POP P,A ;GET TEXT POINTER BACK
ILDB B,A ;NEXT CHARACTER
CAIE B,"%" ;PASS FOLLOWING %
MOVE A,1(P)
JRST ETYP2 ;CONTINUE TYPING
;%LETS UN%
;%ETYPE...
;DISPATCH TABLE FOR LETTERS AFTER %
%LETS: %A ;CURRENT TIME
%B ;CPU TIME USED
%C ;CONNECT TIME
%D ;CURRENT DATE
%E ;SAME TIME AS LAST %D
%F ;"FORK N " IF >1 INFERIOR
%G ;CONNECTED DIR NAME
%H ;DEVICE NAME FOR DESIGNATOR IN INDICATED AC
%I ;NUMBER OF LOGGED IN USERS
%J ;TSS JOB #
%K ;UPTIME
%L ;"LINE N" OR "DETACHED"
%M ;ACCT # OR STRING POINTER, AS FOR LOGIN
%N ;NAME UNDER WHICH USER IS LOGGED IN
%O ;CONTENTS OF SPECIFIED AC IN OCTAL
%P ;CONTENTS OF RIGHT HALF OF SPECIFIED AC IN OCTAL
%Q ;CONTENTS OF AC IN DECIMAL
%R ;DIRECTORY NAME FOR DIR # IN AC
%S ;FILE NAME FOR JFN IN AC
%T ;CONTENTS OF AC AS PERCENTAGE OF UP TIME
%U ;DECIMAL BIT NUMBERS, SEPARATED BY COMMAS
%V ;CPU TIME WITH TENTHS OF SECONDS
UN%
%X ;TYPE ILLEG INST ERROR MSG
%Y ;RETYPE COMMAND LINE, A LA ↑R
%Z ;TYPE KEYWORDS IN TABLE AC POINTS TO
;UNRECOGNIZED %-CODE
UN%: SUB P,[XWD 1,1] ;FORGET RETURN
POP P,A ;RECOVER TEXT POINTER
TYPE <%> ;DIGIT, IF ANY, IS LOST.
JRST ETYP2A ;CONTINUE TYPING, STARTING WITH CHAR AFTER %.
;%A A1 A2 %B %B1 %C %D %E
;%ETYPE...
;ROUTINES FOR LETTERS AFTER %.
;THESE ROUTINES RECEIVE IN C: CONTENTS OF SPECIFIED AC, OR 0 IF NONE.
;THEY MAY CLOBBER AC'S A, B, C, AND D ONLY.
;CURRENT TIME
%A: GTAD ;GET CURRENT DATE & TIME
A1: HRLZI C,B0+B10+B17 ;NO DATE, NO SECONDS. 24-HR TIME.
A2: MOVE B,A
MOVE A,COJFN
CAMN B,[-1] ;DOES SYSTEM HAVE DATE & TIME?
HRLZI B,1 ;CHANGE TO CALL SCREWUP ←←←←←←←←
ODTIM
RET
;CPU TIME USED. ALSO SEE %V.
%B: HRROI A,-5 ;SAY WHOLE JOB
RUNTM
%B1: IDIV A,B ;CONVERT TO SECS
JRST TOUT ;TYPE AS H:MM:SS
;CONSOLE TIME USED
%C: HRROI A,-5
RUNTM
MOVE A,C
JRST %B1
;DATE
%D: SKIPN A,C ;USE GIVEN QUANTITY IF ANY
GTAD ;GET CURRENT DATE & TIME FROM SYSTEM
MOVEM A,%EDAYT ;SAVE FOR %E
HRLZI C,B9+B17 ;DATE ONLY, STANDARD CONCISE FORMAT
JRST A2 ;GO PRINT DATE
;SAME TIME AS LAST %D, TO AVOID INCONSISTENCIES AT MIDNITE.
%E: MOVE A,%EDAYT
JRST A1 ;SEE %A
;%F %H
;ETYPE'S % ROUTINES ...
;TYPE "FORK N " ONLY IF THIS EXEC HAS >1 INFERIORS.
; GET FORK HANDLE FROM INDICATED AC, OR IF NONE, CELL "LRFORK".
;FIRST READ FORK STRUCTURE TO FIND OUT HOW MANY FORKS THERE ARE.
%F: RET ;CASTRATED TEMPORARILY BECAUSE GFRKS NOT DONE AND
;THERE'S NO WAY OF GETTING A HANDLE ON FORK MORE THAN
;ONE LEVEL DOWN YET AND THERE'S NO WAY THE EXEC CAN
;GET MORE THAN ONE IMMEDIATE INFERIOR. HENCE LRFORK
;IS ALWAYS THE EXEC'S FIRST AND ONLY IMMED INFERIOR.
; 5/22/70. ←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←←
; MOVEI A,400000 ;SAY START AT SELF
; MOVEI B,CSBUF ;USE STRING BUFFER
; GFRKS ;GET FORK STRUCTURE
; HRRZ A,(B) ;PTR TO INFERIOR
; MOVE A,(A) ;XWD ITS PARELLEL, ITS INFERIOR
; JUMPE A,[RET] ;NEITHER EXISTS, PRINT NOTHING.
; TYPE <FORK >;
; SKIPG B,C ;USE GIVEN HANDLE IF SUPPLIED
; MOVE B,LRFORK ;ELSE HANDLE OF LAST RUN FORK
; TRZ B,B0 ;PRINT ## NOT 4000##.
; CALL TOCT ;OCTAL OUTPUT FROM B
; PRINT " "
; RET
;DEVICE NAME FOR DESIGNATOR IN INDCATED AC.
%H: MOVE A,C
DVCHR ;TRANSLATE JFN (IF GIVEN) TO DEVICE DESIGNATOR
MOVE B,A
MOVE A,COJFN
DEVST ;DEVICE TO STRING
CALL JERR
RET
;%I %I1 %I3 %K
;NUMBER OF USERS ON SYSTEM.
;COUNTS NUMBER OF POSITIVE ENTRIES IN SYSTEM TABLE 1.
%I: SETZ B, ;COUNTER
SETO D, ;TABLE WORD -1 IS LENGTH
GTB 1
HRLZ D,A ;SET UP LOOP COUNTER/TABLE INDEX
; GTB 1
; JUMPL A,%I1 ;NO JOB 0
; GTB 0
; JUMPL A,%I3 ;IGNORE DETACHED JOB 0
%I1: GTB 1 ;TABLE 1 IS POSITIVE IF JOB EXISTS
JUMPL A,%I3
GTB 3 ;TABLE 3 ENTRY RH IS 0 IF NOT LOGGED IN
TRNE A,-1 ;OMIT UNLOGGEDIN USERS FROM COUNT
AOS B
%I3: AOBJN D,%I1
JUMPE B,[UTYPE [ASCIZ /No jobs/]
RET]
CAIN B,1
JRST [ UTYPE [ASCIZ /One job/]
RET]
MOVE A,COJFN
MOVEI C,↑D10
NOUT ;PRINT NUMBER
CALL JERRC ;ERROR NUMBER IN C
CAIL B,↑D10
PRINT "!"
CAIL B,↑D15
PRINT "!"
CAIL B,↑D20
PRINT "!"
TYPE < jobs>
RET
;UPTIME
%K: TIME ;TIME SINCE SYSTEM RESTARTED
IDIV A,B ;CONVERT TO SECONDS
CALL TOUT ;PRINT AS HH:MM:SS
CAIL A,↑D50*↑D3600
PRINT "!"
CAML A,[↑D100*↑D3600]
PRINT "!"
CAML A,[↑D150*↑D3600]
PRINT "!"
RET
;%L %M %G %N
;ETYPE'S % ROUTINES ...
;"TTY N" OR "DETACHED"
%L: GJINF
JUMPL D,[UTYPE [ASCIZ /Detached/]
RET]
TYPE <TTY>;
MOVE A,COJFN
MOVE B,D
JRST TOCT ;TYPE OCTAL FROM B
;ACCOUNT
;TAKES 5B2+NUMBER, OR STRING POINTER, IN INDICATED AC, AS LOGIN.
%M: MOVE A,COJFN
LDB B,[POINT 3,C,2]
CAIE B,5
JRST [ MOVE B,C
SETZ C,
SOUT
RET]
MOVE B,C
TLZ B,700000
MOVEI C,↑D10
NOUT
CALL JERRC
RET
;NAME OF CONNECTED DIRECTORY. MUST PRECEDE %N.
%G: GJINF
JRST .+3
;USER (DIRECTORY) NAME LOGGED IN UNDER.
%N: GJINF
MOVE B,A ;LOGIN DIRECTORY NO
MOVE A,COJFN
DIRST
PRINT "?" ;NASSIGNED DIR #, NO SYST ERR # IN A.
RET
;%O %P %J %Q %Q2 %Q1 FLOAT
;ETYPE'S % ROUTINES...
;OCTAL NUMBER IN SPECIFIED AC.
%O: MOVE B,C
JRST TOCT ;TYPE OCTAL FROM B
;18 BIT OCTAL NUMBER FROM RIGHT HALF OF SPECIFIED AC
%P: HRRZ B,C
JRST TOCT
;TSS JOB NUMBER. MUST PRECEDE %Q.
%J: GJINF ;GETS JOB # IN C
;FLOATING PT OR DECIMAL NUMBER FROM AC.
;PRINT AS FLOATING IF NORMALIZED AND WITH EXPONENT 100<E<377
%Q: MOVE B,C
MOVM C,B
TLNE C,700000 ;EXPONENT .GE. 100?
TLNN C,400 ;NORMALIZED?
JRST %Q1 ;NO, PRINT DECIMAL
CAMGE C,[1.0E5] ;CAN ACCOMMODATE FIXED POINT?
JRST %Q2 ;YES, DON'T USE FLOUT
MOVEI A,3 ;MIN NUMBER OF COLUMNS FOR FIELD 1
CAMGE C,[100.0] ;FIND RANGE OF NUMBER
JRST .+3
FDVRI C,(10.0) ;REDUCE NUMBER
AOJA A,.-3 ;COUNT ONE MORE PLACE FOR FIELD 1
MOVE C,[1B4+1B6+2B29] ;POINT AND AT LEAST ONE DIG TO LEFT
DPB A,[POINT 6,C,23] ;AND 2 DIG AFTER PT
MOVE A,COJFN
FLOUT
CALL JERRC
RET
;HERE TO DO OUR OWN FLOATING OUTPUT RATHER THAN CALLING FLOUT
%Q2: FMPRI C,(100.0) ;WANT TWO DIGITS PAST DECIMAL POINT
FADRI C,(0.5) ;ROUND
MULI C,400 ;CONVERT TO INTEGER
ASH D,-243(C)
SKIPL B ;CORRECT SIGN
SKIPA C,D
MOVN C,D
IDIVI C,↑D100 ;GET INTEGER PART
PRINT " " ;ALWAYS ONE LEADING BLANK
MOVE B,C ;PRINT INTEGER PART
CALL %Q1
PRINT "."
MOVM B,D
SKIPA C,[1B2+1B3+2B17+↑D10]
%Q1: MOVEI C,↑D10
MOVE A,COJFN
NOUT
CALL JERRC
RET
;FLOAT THE INTEGER IN A
FLOAT: IDIVI A,400000 ;BREAK NUMBER INTO TWO PARTS
FSC A,254 ;CONVERT HIGH PART
FSC B,233 ;CONVERT LOW PART
FADR A,B ;COMBINE PARTS
RET
;%R %S %T
;DIRECTORY NAME FOR NUMBER IN AC
%R: MOVE A,COJFN
MOVE B,C
DIRST
PRINT "?"
RET
;FILE NAME FOR JFN IN AC
%S: MOVE A,COJFN
MOVE B,C
SETZ C,
JFNS
RET
;CONTENTS OF AC AS PERCENTAGE OF UP TIME
%T: TIME ;GET UPTIME IN A
MULI C,↑D200
DIV C,A ;HOPE DIVISORS TO CONVERT TO SECS ARE SAME
ADDI C,1 ;ROUND
LSH C,-1
CALL %Q ;PRINT IN DECIMAL
PRINT "%"
RET
;%U %U1 %U2 %U3 %V
;ETYPE'S % ROUTINES...
;CONTENTS OF AC AS LIST OF DECIMAL NUMBERS FOR SET BITS,
; OR "NONE" IF AC 0.
%U: JUMPE C,[UTYPE [ASCIZ /None/]
RET]
SETZ D, ;BIT NUMBER
TLNE C,B0 ;FIND FIRST SET BIT
JRST %U2
LSH C,1
AOS D
JRST .-4 ;LOOP FOR SUCCESSIVE BITS
%U1: TLNN C,B0
JRST %U3
PRINT "," ;COMMA (AND SPACE) BEFORE ALL BUT FIRST
MOVE A,COJFN
RFPOS
MOVEI B,(B)
CAIL B,↑D55
PRINT EOL ;EOL IF TOO FAR RIGHT
PRINT " "
%U2: ETYPE <%4Q> ;BIT # IN DECIMAL
%U3: AOS D
LSH C,1
JUMPN C,%U1
RET
;CPU TIME USED, INCLUDING TENTHS OF SECONDS, FOR ↑T FOR DGB.
%V: HRROI A,-5 ;SAY WHOLE JOB
RUNTM
MOVE C,B ;TICKS PER SECOND
IDIV A,B ;CONVERT TIME IN TICKS TO SECS
CALL TOUT ;TYPE H:MM:SS
IDIVI C,↑D10 ;GET TICKS PER 1/10 SEC
JUMPN D,[RET] ;NOT EVEN, DON'T PRINT TENTHS OF SECS
IDIV B,C ;CONVERT REMAINDER OF TICKS TO TENTHS
ETYPE <.%2Q>; ;TYPE TENTHS OF SECONDS
RET
;%X %X1 %X3 %X9
;ETYPE'S % ROUTINES...
;TYPE VALUE OF ILLEGAL INSTRUCTION, " AT" PC, AND,
; IF ILLEG INSTRUCTION WAS A JSYS, A SYSTEM ERROR MESSAGE.
;FORK HANDLE IN LRFORK, PC IN AC.
;USED IN A MESSAGE IN TABLE "WHY" THAT IS USED BY "START", "RUNSTAT", ↑T
%X: SETZB B,D ;SAY HAVEN'T GOT INSTRUCTION YET
MOVEI A,-1(C) ;MASK PC AND SUBTRACT 1
%X1: PUSH P,FORK
SKIPGE EFORK ;USE EFORK IF THERE IS ONE, LRFORK IF NOT
PUSH P,LRFORK ;MOVE-MOVEM WITHOUT USING AN AC
SKIPL EFORK
PUSH P,EFORK
POP P,FORK ;SET "FORK" FOR MAPPF
CALL MAPPF ;MAP PAGE OF FORK INTO BUFFER "PAGEN"
POP P,FORK
TLNE A,B5 ;NO SUCH PAGE (SHOULDN'T OCCUR)
TLNN A,B2
JRST %X3 ;READ PROTECTED, FORGET IT
ANDI A,777 ;MASK ADDRESS WITHIN PAGE
JUMPN D,.+2 ;JUMP IF TRACING AN XCT
MOVE D,PAGEN(A) ;PICK UP INST 1ST TIME THROUGH
HLRZ B,PAGEN(A) ;FETCH LH OF INST THAT FAILED
TRZ B,740 ;IGNORE AC FIELD
CAIN B,<XCT>B53 ;TRACE SIMPLE XCT'S.
;DON'T HANDLE INDEXING OR
;INDIRECT ADDRESSING.
JRST [ MOVEI A,@PAGEN(A) ;GET EFF ADDR
JRST %X1] ;GO BACK AND GET ADDRESSED WORD
ETYPE <%4O > ;TYPE INSTRUCTION
%X3: ETYPE <at %3P> ;PC
CAIE B,<JSYS>B53
JRST %X9 ;NOT A JSYS, DONE
TYPE < - JSYS error:
>;
SKIPGE A,EFORK ;USE EPHEMERON IF IT EXISTS, ELSE LRFORK
SKIPL A,LRFORK ;GET ERROR CODE NOW FOR ERSTR ERR RET
CALL $GETER ;DO GETER JSYS, PRESERVING 4-10
MOVE A,COJFN
SETZ C,
ERSTR ;PRINT SYSTEM ERR MSG FOR CODE IN B
JRST [ UETYPE [ASCIZ /Error message not found for error %2P/]
JRST .+2] ;R1: BAD ERROR NUMBER
JRST .+1 ;R2: DESTINATION PROBLEM, FORGET IT.
%X9: SETO A,
JRST MAPPF ;UNMAP PAGE THEN RETURN
;%Y %Z %Z1 %Z2
;ETYPE'S % ROUTINES...
;RETYPE CURRENT COMMAND INPUT LINE
%Y: PRINT EOL
PRINT " "
MOVE B,BFP
IDPB C,B ;TERMINATE WITH NULL: ASSUME C 0.
UTYPE CBUF
RET
;LIST ALL KEYWORDS IN TABLE AC POINTS TO
%Z: SKIPN A,(C) ;PICK UP TABLE COUNT
RET ;NULL TABLE
%Z1: AOS C ;STEP TABLE POINTER
HLRZ B,(C) ;LH OF TABLE WORD POINTS TO...
MOVE B,(B) ;VALUE WORD
TLNE B,INVIS
JRST %Z2 ;DON'T PRINT IF "INVISIBLE"
MOVE B,(C) ;RH OF TABLE WORD POINTS TO TEXT
PRINT " "
UTYPE (B) ;TYPE TEXT OF TABLE ENTRY
PRINT EOL
%Z2: SOJG A,%Z1 ;ENDTEST AND LOOP
RET
;TOUT
;SUBROUTINE TO TYPE NUMBER OF SECONDS IN A IN THE FORM H:MM:SS.
TOUT: PUSH P,A
PUSH P,B
PUSH P,C
MOVE B,A
MOVE A,COJFN
IDIVI B,↑D3600
PUSH P,C
MOVEI C,↑D10
NOUT ;HOURS
CALL JERRC
PRINT ":"
POP P,B
IDIVI B,↑D60
PUSH P,C
MOVE C,[XWD B2+B3+2,↑D10] ;2 COLS, LEADING 0'S.
NOUT ;MINUTES
CALL JERRC
PRINT ":"
POP P,B
NOUT ;SECONDS
CALL JERRC
JRST [ POP P,C
POP P,B
POP P,A
RET]
;UNMAP
; UNMAP ALL USELESS PRIVATE PAGES
; CALLED BY ERROR (↑C), AND "RESET"
;PAGE 747 IS "RSYSTAT" PAGE FOR NETLOAD COMMAND
;PAGES 750 TO 767 INCLUDE BUF1, BUF2, DIRECTORY
UNMAP: SETO A,
MOVE B,[400000,,747]
HRLZI C,1
MOVEI D,21
PMAP
AOS B
SOJG D,.-2
RET
;$SYSGT SYSGT1 SYSGT2 SYSGT3 SYSGT4
;$SYSGT SIMULATES A SYSGT JSYS BY TRYING A HASH LOOKUP IN A LOCAL TABLE
; FIRST, AND THEN THE SYSTEM IF IT IS NOT IN THE TABLE. NOTE
; THE SYSTEM DOES A (SLOW) LINEAR SEARCH PLUS CONTEXT SWITCHES.
; AC'S AT ENTRY AND EXIT ARE EXACTLY THOSE OF SYSGT
$SYSGT: PUSH P,C ;SAVE FOR CALLER
PUSH P,A ;SIXBIT OF TABLE NAME
MOVEI C,SGTBLN ;COUNT THIS MANY PROBES (TABLE FULLNESS)
TSC A,A
LSH A,-1 ;FAST HASH IS BETTER THAN BURNED CYCLES
IDIVI A,SGTBLN ;ON A BIG TABLE, AT LEAST.
SYSGT1: SKIPN A,SGTNAM(B) ;GET NAME FROM HASH TABLE
JRST SYSGT2 ;HIT A 0 -- TRY THE SYSTEM
CAMN A,0(P) ;IS THIS THE ONE WE ARE LOOKING FOR?
JRST SYSGT3 ;YES, USE IT.
SOSGE B ;DO LINEAR SEARCH BACKWARDS
MOVEI B,SGTBLN-1 ;RING THE POINTER
SOJG C,SYSGT1 ;BEEN THRU THE WHOLE TABLE?
CALL SCREWUP ;MAKE SGTBLN BIGGER!!!!
SYSGT2: PUSH P,B ;SAVE THE INDEX
MOVE A,-1(P) ;GET BACK THE NAME
SYSGT ;TRY THE SYSTEM
JUMPE B,SYSGT4 ;OH WELL
EXCH B,0(P) ;GET BACK INDEX
POP P,SGTAC2(B) ;INSERT ENTRY INTO HASH TABLE
MOVEM A,SGTAC1(B)
POP P,SGTNAM(B)
MOVE B,SGTAC2(B)
POP P,C
RET
SYSGT3: MOVE A,SGTAC1(B)
MOVE B,SGTAC2(B)
SUB P,[1,,1]
POP P,C
RET
SYSGT4: SUB P,[2,,2]
POP P,C
RET
;FPIN
;FLOATING POINT NUMBER INPUT
;PRE-READS STRING IN ORDER TO DO EDITTING AND NOISE
FPIN: CALL CSTR ;COLLECT A STRING
CAIN TRM,"."
JRST MORE ;GET MORE -- BACK INTO CSTR
AOS CNT ;MAKE BUFFF INCLUDE THE TERMINATOR
CALL BUFFF ;BUFFER UP, READY FOR A JSYS CALL
SOS CNT
FLIN ;INPUT FLOATING NUMBER FROM BUFFER
CALL [ CAIN A,FLINX4 ;-.Q AND OTHER FUNNY FORMATS
JRST [ LDB B,A ;GET THE LAST CHARACTER READ
JUMPE B,[SUB P,[1,,1] ;READ IT ALL
JRST MORE] ;GO BACK INTO CSTR
JRST CERR] ;DIDN'T USE ALL CHARACTERS
CAIN C,FLINX1 ;BAD FORMAT
JRST CERR
CAIE C,FLINX2 ;UNDER FLOW
CAIN C,FLINX3 ;OVER FLOW
JRST CERR
JRST JERRC] ;ANYTHING ELSE BOMBS THE EXEC
IBP A ;STEP OVER THE NULL
CAME A,CSBUFP ;FLIN USED THE ENTIRE STRING?
JRST CERR ;NO
MOVE A,B ;HERE IS THE ANSWER
RET ;CALLER IS TO DO TERM CHK AND CONF
END EXEC